1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 -- The following representation clause ensures that the above record
61 -- has no holes. We do this so that when instances of this record are
62 -- written by Tree_Gen, we do not write uninitialized values to the file.
64 for Ureal_Entry use record
65 Num at 0 range 0 .. 31;
66 Den at 4 range 0 .. 31;
67 Rbase at 8 range 0 .. 31;
68 Negative at 12 range 0 .. 31;
71 for Ureal_Entry'Size use 16 * 8;
72 -- This ensures that we did not leave out any fields
74 package Ureals is new Table.Table (
75 Table_Component_Type => Ureal_Entry,
76 Table_Index_Type => Ureal'Base,
77 Table_Low_Bound => Ureal_First_Entry,
78 Table_Initial => Alloc.Ureals_Initial,
79 Table_Increment => Alloc.Ureals_Increment,
80 Table_Name => "Ureals");
82 -- The following universal reals are the values returned by the constant
83 -- functions. They are initialized by the initialization procedure.
100 Num_Ureal_Constants : constant := 10;
101 -- This is used for an assertion check in Tree_Read and Tree_Write to
102 -- help remember to add values to these routines when we add to the list.
104 Normalized_Real : Ureal := No_Ureal;
105 -- Used to memoize Norm_Num and Norm_Den, if either of these functions
106 -- is called, this value is set and Normalized_Entry contains the result
107 -- of the normalization. On subsequent calls, this is used to avoid the
108 -- call to Normalize if it has already been made.
110 Normalized_Entry : Ureal_Entry;
111 -- Entry built by most recent call to Normalize
113 -----------------------
114 -- Local Subprograms --
115 -----------------------
117 function Decimal_Exponent_Hi (V : Ureal) return Int;
118 -- Returns an estimate of the exponent of Val represented as a normalized
119 -- decimal number (non-zero digit before decimal point), The estimate is
120 -- either correct, or high, but never low. The accuracy of the estimate
121 -- affects only the efficiency of the comparison routines.
123 function Decimal_Exponent_Lo (V : Ureal) return Int;
124 -- Returns an estimate of the exponent of Val represented as a normalized
125 -- decimal number (non-zero digit before decimal point), The estimate is
126 -- either correct, or low, but never high. The accuracy of the estimate
127 -- affects only the efficiency of the comparison routines.
129 function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int;
130 -- U is a Ureal entry for which the base value is non-zero, the value
131 -- returned is the equivalent decimal exponent value, i.e. the value of
132 -- Den, adjusted as though the base were base 10. The value is rounded
133 -- to the nearest integer, and so can be one off.
135 function Is_Integer (Num, Den : Uint) return Boolean;
136 -- Return true if the real quotient of Num / Den is an integer value
138 function Normalize (Val : Ureal_Entry) return Ureal_Entry;
139 -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a
142 function Same (U1, U2 : Ureal) return Boolean;
143 pragma Inline (Same);
144 -- Determines if U1 and U2 are the same Ureal. Note that we cannot use
145 -- the equals operator for this test, since that tests for equality,
148 function Store_Ureal (Val : Ureal_Entry) return Ureal;
149 -- This store a new entry in the universal reals table and return
150 -- its index in the table.
152 -------------------------
153 -- Decimal_Exponent_Hi --
154 -------------------------
156 function Decimal_Exponent_Hi (V : Ureal) return Int is
157 Val : constant Ureal_Entry := Ureals.Table (V);
160 -- Zero always returns zero
162 if UR_Is_Zero (V) then
165 -- For numbers in rational form, get the maximum number of digits in the
166 -- numerator and the minimum number of digits in the denominator, and
167 -- subtract. For example:
169 -- 1000 / 99 = 1.010E+1
170 -- 9999 / 10 = 9.999E+2
172 -- This estimate may of course be high, but that is acceptable
174 elsif Val.Rbase = 0 then
175 return UI_Decimal_Digits_Hi (Val.Num) -
176 UI_Decimal_Digits_Lo (Val.Den);
178 -- For based numbers, just subtract the decimal exponent from the
179 -- high estimate of the number of digits in the numerator and add
180 -- one to accommodate possible round off errors for non-decimal
181 -- bases. For example:
183 -- 1_500_000 / 10**4 = 1.50E-2
185 else -- Val.Rbase /= 0
186 return UI_Decimal_Digits_Hi (Val.Num) -
187 Equivalent_Decimal_Exponent (Val) + 1;
189 end Decimal_Exponent_Hi;
191 -------------------------
192 -- Decimal_Exponent_Lo --
193 -------------------------
195 function Decimal_Exponent_Lo (V : Ureal) return Int is
196 Val : constant Ureal_Entry := Ureals.Table (V);
199 -- Zero always returns zero
201 if UR_Is_Zero (V) then
204 -- For numbers in rational form, get min digits in numerator, max digits
205 -- in denominator, and subtract and subtract one more for possible loss
206 -- during the division. For example:
208 -- 1000 / 99 = 1.010E+1
209 -- 9999 / 10 = 9.999E+2
211 -- This estimate may of course be low, but that is acceptable
213 elsif Val.Rbase = 0 then
214 return UI_Decimal_Digits_Lo (Val.Num) -
215 UI_Decimal_Digits_Hi (Val.Den) - 1;
217 -- For based numbers, just subtract the decimal exponent from the
218 -- low estimate of the number of digits in the numerator and subtract
219 -- one to accommodate possible round off errors for non-decimal
220 -- bases. For example:
222 -- 1_500_000 / 10**4 = 1.50E-2
224 else -- Val.Rbase /= 0
225 return UI_Decimal_Digits_Lo (Val.Num) -
226 Equivalent_Decimal_Exponent (Val) - 1;
228 end Decimal_Exponent_Lo;
234 function Denominator (Real : Ureal) return Uint is
236 return Ureals.Table (Real).Den;
239 ---------------------------------
240 -- Equivalent_Decimal_Exponent --
241 ---------------------------------
243 function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is
245 -- The following table is a table of logs to the base 10
247 Logs : constant array (Nat range 1 .. 16) of Long_Float := (
248 1 => 0.000000000000000,
249 2 => 0.301029995663981,
250 3 => 0.477121254719662,
251 4 => 0.602059991327962,
252 5 => 0.698970004336019,
253 6 => 0.778151250383644,
254 7 => 0.845098040014257,
255 8 => 0.903089986991944,
256 9 => 0.954242509439325,
257 10 => 1.000000000000000,
258 11 => 1.041392685158230,
259 12 => 1.079181246047620,
260 13 => 1.113943352306840,
261 14 => 1.146128035678240,
262 15 => 1.176091259055680,
263 16 => 1.204119982655920);
266 pragma Assert (U.Rbase /= 0);
267 return Int (Long_Float (UI_To_Int (U.Den)) * Logs (U.Rbase));
268 end Equivalent_Decimal_Exponent;
274 procedure Initialize is
277 UR_0 := UR_From_Components (Uint_0, Uint_1, 0, False);
278 UR_M_0 := UR_From_Components (Uint_0, Uint_1, 0, True);
279 UR_Half := UR_From_Components (Uint_1, Uint_1, 2, False);
280 UR_Tenth := UR_From_Components (Uint_1, Uint_1, 10, False);
281 UR_1 := UR_From_Components (Uint_1, Uint_1, 0, False);
282 UR_2 := UR_From_Components (Uint_1, Uint_Minus_1, 2, False);
283 UR_10 := UR_From_Components (Uint_1, Uint_Minus_1, 10, False);
284 UR_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, False);
285 UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True);
286 UR_100 := UR_From_Components (Uint_1, Uint_Minus_2, 10, False);
287 UR_2_128 := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);
288 UR_2_M_128 := UR_From_Components (Uint_1, Uint_128, 2, False);
289 UR_2_80 := UR_From_Components (Uint_1, Uint_Minus_80, 2, False);
290 UR_2_M_80 := UR_From_Components (Uint_1, Uint_80, 2, False);
297 function Is_Integer (Num, Den : Uint) return Boolean is
299 return (Num / Den) * Den = Num;
306 function Mark return Save_Mark is
308 return Save_Mark (Ureals.Last);
315 function Norm_Den (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.Den;
329 function Norm_Num (Real : Ureal) return Uint is
331 if not Same (Real, Normalized_Real) then
332 Normalized_Real := Real;
333 Normalized_Entry := Normalize (Ureals.Table (Real));
336 return Normalized_Entry.Num;
343 function Normalize (Val : Ureal_Entry) return Ureal_Entry is
349 M : constant Uintp.Save_Mark := Uintp.Mark;
352 -- Start by setting J to the greatest of the absolute values of the
353 -- numerator and the denominator (taking into account the base value),
354 -- and K to the lesser of the two absolute values. The gcd of Num and
355 -- Den is the gcd of J and K.
357 if Val.Rbase = 0 then
361 elsif Val.Den < 0 then
362 J := Val.Num * Val.Rbase ** (-Val.Den);
367 K := Val.Rbase ** Val.Den;
382 Uintp.Release_And_Save (M, Num, Den);
384 -- Divide numerator and denominator by gcd and return result
389 Negative => Val.Negative);
396 function Numerator (Real : Ureal) return Uint is
398 return Ureals.Table (Real).Num;
405 procedure pr (Real : Ureal) is
415 function Rbase (Real : Ureal) return Nat is
417 return Ureals.Table (Real).Rbase;
424 procedure Release (M : Save_Mark) is
426 Ureals.Set_Last (Ureal (M));
433 function Same (U1, U2 : Ureal) return Boolean is
435 return Int (U1) = Int (U2);
442 function Store_Ureal (Val : Ureal_Entry) return Ureal is
444 Ureals.Increment_Last;
445 Ureals.Table (Ureals.Last) := Val;
447 -- Normalize representation of signed values
450 Ureals.Table (Ureals.Last).Negative := True;
451 Ureals.Table (Ureals.Last).Num := -Val.Num;
461 procedure Tree_Read is
463 pragma Assert (Num_Ureal_Constants = 10);
466 Tree_Read_Int (Int (UR_0));
467 Tree_Read_Int (Int (UR_M_0));
468 Tree_Read_Int (Int (UR_Tenth));
469 Tree_Read_Int (Int (UR_Half));
470 Tree_Read_Int (Int (UR_1));
471 Tree_Read_Int (Int (UR_2));
472 Tree_Read_Int (Int (UR_10));
473 Tree_Read_Int (Int (UR_100));
474 Tree_Read_Int (Int (UR_2_128));
475 Tree_Read_Int (Int (UR_2_M_128));
477 -- Clear the normalization cache
479 Normalized_Real := No_Ureal;
486 procedure Tree_Write is
488 pragma Assert (Num_Ureal_Constants = 10);
491 Tree_Write_Int (Int (UR_0));
492 Tree_Write_Int (Int (UR_M_0));
493 Tree_Write_Int (Int (UR_Tenth));
494 Tree_Write_Int (Int (UR_Half));
495 Tree_Write_Int (Int (UR_1));
496 Tree_Write_Int (Int (UR_2));
497 Tree_Write_Int (Int (UR_10));
498 Tree_Write_Int (Int (UR_100));
499 Tree_Write_Int (Int (UR_2_128));
500 Tree_Write_Int (Int (UR_2_M_128));
507 function UR_Abs (Real : Ureal) return Ureal is
508 Val : constant Ureal_Entry := Ureals.Table (Real);
522 function UR_Add (Left : Uint; Right : Ureal) return Ureal is
524 return UR_From_Uint (Left) + Right;
527 function UR_Add (Left : Ureal; Right : Uint) return Ureal is
529 return Left + UR_From_Uint (Right);
532 function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
533 Lval : Ureal_Entry := Ureals.Table (Left);
534 Rval : Ureal_Entry := Ureals.Table (Right);
539 -- Note, in the temporary Ureal_Entry values used in this procedure,
540 -- we store the sign as the sign of the numerator (i.e. xxx.Num may
541 -- be negative, even though in stored entries this can never be so)
543 if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
546 Opd_Min, Opd_Max : Ureal_Entry;
547 Exp_Min, Exp_Max : Uint;
550 if Lval.Negative then
551 Lval.Num := (-Lval.Num);
554 if Rval.Negative then
555 Rval.Num := (-Rval.Num);
558 if Lval.Den < Rval.Den then
571 Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
578 Negative => Lval.Negative));
585 Negative => (Num < 0)));
591 Ln : Ureal_Entry := Normalize (Lval);
592 Rn : Ureal_Entry := Normalize (Rval);
603 Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
610 Negative => Lval.Negative));
616 Den => Ln.Den * Rn.Den,
618 Negative => (Num < 0))));
628 function UR_Ceiling (Real : Ureal) return Uint is
629 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
633 return UI_Negate (Val.Num / Val.Den);
635 return (Val.Num + Val.Den - 1) / Val.Den;
643 function UR_Div (Left : Uint; Right : Ureal) return Ureal is
645 return UR_From_Uint (Left) / Right;
648 function UR_Div (Left : Ureal; Right : Uint) return Ureal is
650 return Left / UR_From_Uint (Right);
653 function UR_Div (Left, Right : Ureal) return Ureal is
654 Lval : constant Ureal_Entry := Ureals.Table (Left);
655 Rval : constant Ureal_Entry := Ureals.Table (Right);
656 Rneg : constant Boolean := Rval.Negative xor Lval.Negative;
659 pragma Assert (Rval.Num /= Uint_0);
661 if Lval.Rbase = 0 then
663 if Rval.Rbase = 0 then
666 (Num => Lval.Num * Rval.Den,
667 Den => Lval.Den * Rval.Num,
671 elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
673 (Num => Lval.Num / (Rval.Num * Lval.Den),
678 elsif Rval.Den < 0 then
682 Den => Rval.Rbase ** (-Rval.Den) *
691 (Num => Lval.Num * Rval.Rbase ** Rval.Den,
692 Den => Rval.Num * Lval.Den,
697 elsif Is_Integer (Lval.Num, Rval.Num) then
699 if Rval.Rbase = Lval.Rbase then
701 (Num => Lval.Num / Rval.Num,
702 Den => Lval.Den - Rval.Den,
706 elsif Rval.Rbase = 0 then
708 (Num => (Lval.Num / Rval.Num) * Rval.Den,
713 elsif Rval.Den < 0 then
719 Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
720 Den := Rval.Rbase ** (-Rval.Den);
722 Num := Lval.Num / Rval.Num;
723 Den := (Lval.Rbase ** Lval.Den) *
724 (Rval.Rbase ** (-Rval.Den));
736 (Num => (Lval.Num / Rval.Num) *
737 (Rval.Rbase ** Rval.Den),
749 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;
782 function UR_Eq (Left, Right : Ureal) return Boolean is
784 return not UR_Ne (Left, Right);
787 ---------------------
788 -- UR_Exponentiate --
789 ---------------------
791 function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
792 X : constant Uint := abs N;
799 -- If base is negative, then the resulting sign depends on whether
800 -- the exponent is even or odd (even => positive, odd = negative)
802 if UR_Is_Negative (Real) then
803 Neg := (N mod 2) /= 0;
804 Bas := UR_Negate (Real);
810 Val := Ureals.Table (Bas);
812 -- If the base is a small integer, then we can return the result in
813 -- exponential form, which can save a lot of time for junk exponents.
815 IBas := UR_Trunc (Bas);
818 and then UR_From_Uint (IBas) = Bas
823 Rbase => UI_To_Int (UR_Trunc (Bas)),
826 -- If the exponent is negative then we raise the numerator and the
827 -- denominator (after normalization) to the absolute value of the
828 -- exponent and we return the reciprocal. An assert error will happen
829 -- if the numerator is zero.
832 pragma Assert (Val.Num /= 0);
833 Val := Normalize (Val);
836 (Num => Val.Den ** X,
841 -- If positive, we distinguish the case when the base is not zero, in
842 -- which case the new denominator is just the product of the old one
843 -- with the exponent,
846 if Val.Rbase /= 0 then
849 (Num => Val.Num ** X,
854 -- And when the base is zero, in which case we exponentiate
855 -- the old denominator.
859 (Num => Val.Num ** X,
871 function UR_Floor (Real : Ureal) return Uint is
872 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
876 return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
878 return Val.Num / Val.Den;
882 ------------------------
883 -- UR_From_Components --
884 ------------------------
886 function UR_From_Components
890 Negative : Boolean := False)
898 Negative => Negative));
899 end UR_From_Components;
905 function UR_From_Uint (UI : Uint) return Ureal is
907 return UR_From_Components
908 (abs UI, Uint_1, Negative => (UI < 0));
915 function UR_Ge (Left, Right : Ureal) return Boolean is
917 return not (Left < Right);
924 function UR_Gt (Left, Right : Ureal) return Boolean is
926 return (Right < Left);
933 function UR_Is_Negative (Real : Ureal) return Boolean is
935 return Ureals.Table (Real).Negative;
942 function UR_Is_Positive (Real : Ureal) return Boolean is
944 return not Ureals.Table (Real).Negative
945 and then Ureals.Table (Real).Num /= 0;
952 function UR_Is_Zero (Real : Ureal) return Boolean is
954 return Ureals.Table (Real).Num = 0;
961 function UR_Le (Left, Right : Ureal) return Boolean is
963 return not (Right < Left);
970 function UR_Lt (Left, Right : Ureal) return Boolean is
972 -- An operand is not less than itself
974 if Same (Left, Right) then
977 -- Deal with zero cases
979 elsif UR_Is_Zero (Left) then
980 return UR_Is_Positive (Right);
982 elsif UR_Is_Zero (Right) then
983 return Ureals.Table (Left).Negative;
985 -- Different signs are decisive (note we dealt with zero cases)
987 elsif Ureals.Table (Left).Negative
988 and then not Ureals.Table (Right).Negative
992 elsif not Ureals.Table (Left).Negative
993 and then Ureals.Table (Right).Negative
997 -- Signs are same, do rapid check based on worst case estimates of
998 -- decimal exponent, which will often be decisive. Precise test
999 -- depends on whether operands are positive or negative.
1001 elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
1002 return UR_Is_Positive (Left);
1004 elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
1005 return UR_Is_Negative (Left);
1007 -- If we fall through, full gruesome test is required. This happens
1008 -- if the numbers are close together, or in some weird (/=10) base.
1012 Imrk : constant Uintp.Save_Mark := Mark;
1013 Rmrk : constant Urealp.Save_Mark := Mark;
1019 Lval := Ureals.Table (Left);
1020 Rval := Ureals.Table (Right);
1022 -- An optimization. If both numbers are based, then subtract
1023 -- common value of base to avoid unnecessarily giant numbers
1025 if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
1026 if Lval.Den < Rval.Den then
1027 Rval.Den := Rval.Den - Lval.Den;
1030 Lval.Den := Lval.Den - Rval.Den;
1035 Lval := Normalize (Lval);
1036 Rval := Normalize (Rval);
1038 if Lval.Negative then
1039 Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
1041 Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
1055 function UR_Max (Left, Right : Ureal) return Ureal is
1057 if Left >= Right then
1068 function UR_Min (Left, Right : Ureal) return Ureal is
1070 if Left <= Right then
1081 function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
1083 return UR_From_Uint (Left) * Right;
1086 function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
1088 return Left * UR_From_Uint (Right);
1091 function UR_Mul (Left, Right : Ureal) return Ureal is
1092 Lval : constant Ureal_Entry := Ureals.Table (Left);
1093 Rval : constant Ureal_Entry := Ureals.Table (Right);
1094 Num : Uint := Lval.Num * Rval.Num;
1096 Rneg : constant Boolean := Lval.Negative xor Rval.Negative;
1099 if Lval.Rbase = 0 then
1100 if Rval.Rbase = 0 then
1101 return Store_Ureal (
1104 Den => Lval.Den * Rval.Den,
1106 Negative => Rneg)));
1108 elsif Is_Integer (Num, Lval.Den) then
1109 return Store_Ureal (
1110 (Num => Num / Lval.Den,
1112 Rbase => Rval.Rbase,
1115 elsif Rval.Den < 0 then
1116 return Store_Ureal (
1118 (Num => Num * (Rval.Rbase ** (-Rval.Den)),
1121 Negative => Rneg)));
1124 return Store_Ureal (
1127 Den => Lval.Den * (Rval.Rbase ** Rval.Den),
1129 Negative => Rneg)));
1132 elsif Lval.Rbase = Rval.Rbase then
1133 return Store_Ureal (
1135 Den => Lval.Den + Rval.Den,
1136 Rbase => Lval.Rbase,
1139 elsif Rval.Rbase = 0 then
1140 if Is_Integer (Num, Rval.Den) then
1141 return Store_Ureal (
1142 (Num => Num / Rval.Den,
1144 Rbase => Lval.Rbase,
1147 elsif Lval.Den < 0 then
1148 return Store_Ureal (
1150 (Num => Num * (Lval.Rbase ** (-Lval.Den)),
1153 Negative => Rneg)));
1156 return Store_Ureal (
1159 Den => Rval.Den * (Lval.Rbase ** Lval.Den),
1161 Negative => Rneg)));
1167 if Lval.Den < 0 then
1168 Num := Num * (Lval.Rbase ** (-Lval.Den));
1170 Den := Den * (Lval.Rbase ** Lval.Den);
1173 if Rval.Den < 0 then
1174 Num := Num * (Rval.Rbase ** (-Rval.Den));
1176 Den := Den * (Rval.Rbase ** Rval.Den);
1179 return Store_Ureal (
1184 Negative => Rneg)));
1192 function UR_Ne (Left, Right : Ureal) return Boolean is
1194 -- Quick processing for case of identical Ureal values (note that
1195 -- this also deals with comparing two No_Ureal values).
1197 if Same (Left, Right) then
1200 -- Deal with case of one or other operand is No_Ureal, but not both
1202 elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
1205 -- Do quick check based on number of decimal digits
1207 elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
1208 Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
1212 -- Otherwise full comparison is required
1216 Imrk : constant Uintp.Save_Mark := Mark;
1217 Rmrk : constant Urealp.Save_Mark := Mark;
1218 Lval : constant Ureal_Entry := Normalize (Ureals.Table (Left));
1219 Rval : constant Ureal_Entry := Normalize (Ureals.Table (Right));
1223 if UR_Is_Zero (Left) then
1224 return not UR_Is_Zero (Right);
1226 elsif UR_Is_Zero (Right) then
1227 return not UR_Is_Zero (Left);
1229 -- Both operands are non-zero
1233 Rval.Negative /= Lval.Negative
1234 or else Rval.Num /= Lval.Num
1235 or else Rval.Den /= Lval.Den;
1248 function UR_Negate (Real : Ureal) return Ureal is
1250 return Store_Ureal (
1251 (Num => Ureals.Table (Real).Num,
1252 Den => Ureals.Table (Real).Den,
1253 Rbase => Ureals.Table (Real).Rbase,
1254 Negative => not Ureals.Table (Real).Negative));
1261 function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
1263 return UR_From_Uint (Left) + UR_Negate (Right);
1266 function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
1268 return Left + UR_From_Uint (-Right);
1271 function UR_Sub (Left, Right : Ureal) return Ureal is
1273 return Left + UR_Negate (Right);
1280 function UR_To_Uint (Real : Ureal) return Uint is
1281 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1285 Res := (Val.Num + (Val.Den / 2)) / Val.Den;
1287 if Val.Negative then
1288 return UI_Negate (Res);
1298 function UR_Trunc (Real : Ureal) return Uint is
1299 Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1302 if Val.Negative then
1303 return -(Val.Num / Val.Den);
1305 return Val.Num / Val.Den;
1313 procedure UR_Write (Real : Ureal) is
1314 Val : constant Ureal_Entry := Ureals.Table (Real);
1317 -- If value is negative, we precede the constant by a minus sign
1318 -- and add an extra layer of parentheses on the outside since the
1319 -- minus sign is part of the value, not a negation operator.
1321 if Val.Negative then
1325 -- Constants in base 10 can be written in normal Ada literal style
1327 if Val.Rbase = 10 then
1328 UI_Write (Val.Num / 10);
1330 UI_Write (Val.Num mod 10);
1332 if Val.Den /= 0 then
1334 UI_Write (1 - Val.Den);
1337 -- Constants in a base other than 10 can still be easily written
1338 -- in normal Ada literal style if the numerator is one.
1340 elsif Val.Rbase /= 0 and then Val.Num = 1 then
1341 Write_Int (Val.Rbase);
1342 Write_Str ("#1.0#E");
1343 UI_Write (-Val.Den);
1345 -- Other constants with a base other than 10 are written using one
1346 -- of the following forms, depending on the sign of the number
1347 -- and the sign of the exponent (= minus denominator value)
1349 -- (numerator.0*base**exponent)
1350 -- (numerator.0*base**(-exponent))
1352 elsif Val.Rbase /= 0 then
1354 UI_Write (Val.Num, Decimal);
1356 Write_Int (Val.Rbase);
1359 if Val.Den <= 0 then
1360 UI_Write (-Val.Den, Decimal);
1364 UI_Write (Val.Den, Decimal);
1370 -- Rational constants with a denominator of 1 can be written as
1371 -- a real literal for the numerator integer.
1373 elsif Val.Den = 1 then
1374 UI_Write (Val.Num, Decimal);
1377 -- Non-based (rational) constants are written in (num/den) style
1381 UI_Write (Val.Num, Decimal);
1383 UI_Write (Val.Den, Decimal);
1387 -- Add trailing paren for negative values
1389 if Val.Negative then
1398 function Ureal_0 return Ureal is
1407 function Ureal_1 return Ureal is
1416 function Ureal_2 return Ureal is
1425 function Ureal_10 return Ureal is
1434 function Ureal_100 return Ureal is
1443 function Ureal_10_36 return Ureal is
1452 function Ureal_2_80 return Ureal is
1461 function Ureal_2_128 return Ureal is
1470 function Ureal_2_M_80 return Ureal is
1479 function Ureal_2_M_128 return Ureal is
1488 function Ureal_Half return Ureal is
1497 function Ureal_M_0 return Ureal is
1506 function Ureal_M_10_36 return Ureal is
1515 function Ureal_Tenth return Ureal is