1
------------------------------------------------------------------------------
3
-- GNAT COMPILER COMPONENTS --
11
-- Copyright (C) 1992-2000 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 accomodate 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 accomodate 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 Ureal_Half return Ureal is
499
function Ureal_Tenth return Ureal is
508
function Ureal_0 return Ureal is
517
function Ureal_1 return Ureal is
526
function Ureal_10 return Ureal is
535
function Ureal_100 return Ureal is
544
function Ureal_2 return Ureal is
553
function Ureal_2_128 return Ureal is
562
function Ureal_2_M_128 return Ureal is
571
function Ureal_M_0 return Ureal is
580
function UR_Abs (Real : Ureal) return Ureal is
581
Val : constant Ureal_Entry := Ureals.Table (Real);
595
function UR_Add (Left : Uint; Right : Ureal) return Ureal is
597
return UR_From_Uint (Left) + Right;
600
function UR_Add (Left : Ureal; Right : Uint) return Ureal is
602
return Left + UR_From_Uint (Right);
605
function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
606
Lval : Ureal_Entry := Ureals.Table (Left);
607
Rval : Ureal_Entry := Ureals.Table (Right);
612
-- Note, in the temporary Ureal_Entry values used in this procedure,
613
-- we store the sign as the sign of the numerator (i.e. xxx.Num may
614
-- be negative, even though in stored entries this can never be so)
616
if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
619
Opd_Min, Opd_Max : Ureal_Entry;
620
Exp_Min, Exp_Max : Uint;
623
if Lval.Negative then
624
Lval.Num := (-Lval.Num);
627
if Rval.Negative then
628
Rval.Num := (-Rval.Num);
631
if Lval.Den < Rval.Den then
644
Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
651
Negative => Lval.Negative));
658
Negative => (Num < 0)));
664
Ln : Ureal_Entry := Normalize (Lval);
665
Rn : Ureal_Entry := Normalize (Rval);
676
Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
683
Negative => Lval.Negative));
689
Den => Ln.Den * Rn.Den,
691
Negative => (Num < 0))));
701
function UR_Ceiling (Real : Ureal) return Uint is
702
Val : Ureal_Entry := Normalize (Ureals.Table (Real));
706
return UI_Negate (Val.Num / Val.Den);
708
return (Val.Num + Val.Den - 1) / Val.Den;
716
function UR_Div (Left : Uint; Right : Ureal) return Ureal is
718
return UR_From_Uint (Left) / Right;
721
function UR_Div (Left : Ureal; Right : Uint) return Ureal is
723
return Left / UR_From_Uint (Right);
726
function UR_Div (Left, Right : Ureal) return Ureal is
727
Lval : constant Ureal_Entry := Ureals.Table (Left);
728
Rval : constant Ureal_Entry := Ureals.Table (Right);
729
Rneg : constant Boolean := Rval.Negative xor Lval.Negative;
732
pragma Assert (Rval.Num /= Uint_0);
734
if Lval.Rbase = 0 then
736
if Rval.Rbase = 0 then
739
(Num => Lval.Num * Rval.Den,
740
Den => Lval.Den * Rval.Num,
744
elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
746
(Num => Lval.Num / (Rval.Num * Lval.Den),
751
elsif Rval.Den < 0 then
755
Den => Rval.Rbase ** (-Rval.Den) *
764
(Num => Lval.Num * Rval.Rbase ** Rval.Den,
765
Den => Rval.Num * Lval.Den,
770
elsif Is_Integer (Lval.Num, Rval.Num) then
772
if Rval.Rbase = Lval.Rbase then
774
(Num => Lval.Num / Rval.Num,
775
Den => Lval.Den - Rval.Den,
779
elsif Rval.Rbase = 0 then
781
(Num => (Lval.Num / Rval.Num) * Rval.Den,
786
elsif Rval.Den < 0 then
792
Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
793
Den := Rval.Rbase ** (-Rval.Den);
795
Num := Lval.Num / Rval.Num;
796
Den := (Lval.Rbase ** Lval.Den) *
797
(Rval.Rbase ** (-Rval.Den));
809
(Num => (Lval.Num / Rval.Num) *
810
(Rval.Rbase ** Rval.Den),
822
Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
827
Den := Rval.Num * (Lval.Rbase ** Lval.Den);
830
if Rval.Rbase /= 0 then
832
Den := Den * (Rval.Rbase ** (-Rval.Den));
834
Num := Num * (Rval.Rbase ** Rval.Den);
838
Num := Num * Rval.Den;
855
function UR_Eq (Left, Right : Ureal) return Boolean is
857
return not UR_Ne (Left, Right);
860
---------------------
861
-- UR_Exponentiate --
862
---------------------
864
function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
872
-- If base is negative, then the resulting sign depends on whether
873
-- the exponent is even or odd (even => positive, odd = negative)
875
if UR_Is_Negative (Real) then
876
Neg := (N mod 2) /= 0;
877
Bas := UR_Negate (Real);
883
Val := Ureals.Table (Bas);
885
-- If the base is a small integer, then we can return the result in
886
-- exponential form, which can save a lot of time for junk exponents.
888
IBas := UR_Trunc (Bas);
891
and then UR_From_Uint (IBas) = Bas
896
Rbase => UI_To_Int (UR_Trunc (Bas)),
899
-- If the exponent is negative then we raise the numerator and the
900
-- denominator (after normalization) to the absolute value of the
901
-- exponent and we return the reciprocal. An assert error will happen
902
-- if the numerator is zero.
905
pragma Assert (Val.Num /= 0);
906
Val := Normalize (Val);
909
(Num => Val.Den ** X,
914
-- If positive, we distinguish the case when the base is not zero, in
915
-- which case the new denominator is just the product of the old one
916
-- with the exponent,
919
if Val.Rbase /= 0 then
922
(Num => Val.Num ** X,
927
-- And when the base is zero, in which case we exponentiate
928
-- the old denominator.
932
(Num => Val.Num ** X,
944
function UR_Floor (Real : Ureal) return Uint is
945
Val : Ureal_Entry := Normalize (Ureals.Table (Real));
949
return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
951
return Val.Num / Val.Den;
955
-------------------------
956
-- UR_From_Components --
957
-------------------------
959
function UR_From_Components
963
Negative : Boolean := False)
971
Negative => Negative));
972
end UR_From_Components;
978
function UR_From_Uint (UI : Uint) return Ureal is
980
return UR_From_Components
981
(abs UI, Uint_1, Negative => (UI < 0));
988
function UR_Ge (Left, Right : Ureal) return Boolean is
990
return not (Left < Right);
997
function UR_Gt (Left, Right : Ureal) return Boolean is
999
return (Right < Left);
1002
--------------------
1003
-- UR_Is_Negative --
1004
--------------------
1006
function UR_Is_Negative (Real : Ureal) return Boolean is
1008
return Ureals.Table (Real).Negative;
1011
--------------------
1012
-- UR_Is_Positive --
1013
--------------------
1015
function UR_Is_Positive (Real : Ureal) return Boolean is
1017
return not Ureals.Table (Real).Negative
1018
and then Ureals.Table (Real).Num /= 0;
1025
function UR_Is_Zero (Real : Ureal) return Boolean is
1027
return Ureals.Table (Real).Num = 0;
1034
function UR_Le (Left, Right : Ureal) return Boolean is
1036
return not (Right < Left);
1043
function UR_Lt (Left, Right : Ureal) return Boolean is
1045
-- An operand is not less than itself
1047
if Same (Left, Right) then
1050
-- Deal with zero cases
1052
elsif UR_Is_Zero (Left) then
1053
return UR_Is_Positive (Right);
1055
elsif UR_Is_Zero (Right) then
1056
return Ureals.Table (Left).Negative;
1058
-- Different signs are decisive (note we dealt with zero cases)
1060
elsif Ureals.Table (Left).Negative
1061
and then not Ureals.Table (Right).Negative
1065
elsif not Ureals.Table (Left).Negative
1066
and then Ureals.Table (Right).Negative
1070
-- Signs are same, do rapid check based on worst case estimates of
1071
-- decimal exponent, which will often be decisive. Precise test
1072
-- depends on whether operands are positive or negative.
1074
elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
1075
return UR_Is_Positive (Left);
1077
elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
1078
return UR_Is_Negative (Left);
1080
-- If we fall through, full gruesome test is required. This happens
1081
-- if the numbers are close together, or in some wierd (/=10) base.
1085
Imrk : constant Uintp.Save_Mark := Mark;
1086
Rmrk : constant Urealp.Save_Mark := Mark;
1092
Lval := Ureals.Table (Left);
1093
Rval := Ureals.Table (Right);
1095
-- An optimization. If both numbers are based, then subtract
1096
-- common value of base to avoid unnecessarily giant numbers
1098
if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
1099
if Lval.Den < Rval.Den then
1100
Rval.Den := Rval.Den - Lval.Den;
1103
Lval.Den := Lval.Den - Rval.Den;
1108
Lval := Normalize (Lval);
1109
Rval := Normalize (Rval);
1111
if Lval.Negative then
1112
Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
1114
Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
1128
function UR_Max (Left, Right : Ureal) return Ureal is
1130
if Left >= Right then
1141
function UR_Min (Left, Right : Ureal) return Ureal is
1143
if Left <= Right then
1154
function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
1156
return UR_From_Uint (Left) * Right;
1159
function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
1161
return Left * UR_From_Uint (Right);
1164
function UR_Mul (Left, Right : Ureal) return Ureal is
1165
Lval : constant Ureal_Entry := Ureals.Table (Left);
1166
Rval : constant Ureal_Entry := Ureals.Table (Right);
1167
Num : Uint := Lval.Num * Rval.Num;
1169
Rneg : constant Boolean := Lval.Negative xor Rval.Negative;
1172
if Lval.Rbase = 0 then
1173
if Rval.Rbase = 0 then
1174
return Store_Ureal (
1177
Den => Lval.Den * Rval.Den,
1179
Negative => Rneg)));
1181
elsif Is_Integer (Num, Lval.Den) then
1182
return Store_Ureal (
1183
(Num => Num / Lval.Den,
1185
Rbase => Rval.Rbase,
1188
elsif Rval.Den < 0 then
1189
return Store_Ureal (
1191
(Num => Num * (Rval.Rbase ** (-Rval.Den)),
1194
Negative => Rneg)));
1197
return Store_Ureal (
1200
Den => Lval.Den * (Rval.Rbase ** Rval.Den),
1202
Negative => Rneg)));
1205
elsif Lval.Rbase = Rval.Rbase then
1206
return Store_Ureal (
1208
Den => Lval.Den + Rval.Den,
1209
Rbase => Lval.Rbase,
1212
elsif Rval.Rbase = 0 then
1213
if Is_Integer (Num, Rval.Den) then
1214
return Store_Ureal (
1215
(Num => Num / Rval.Den,
1217
Rbase => Lval.Rbase,
1221
elsif Lval.Den < 0 then
1222
return Store_Ureal (
1224
(Num => Num * (Lval.Rbase ** (-Lval.Den)),
1227
Negative => Rneg)));
1230
return Store_Ureal (
1233
Den => Rval.Den * (Lval.Rbase ** Lval.Den),
1235
Negative => Rneg)));
1241
if Lval.Den < 0 then
1242
Num := Num * (Lval.Rbase ** (-Lval.Den));
1244
Den := Den * (Lval.Rbase ** Lval.Den);
1247
if Rval.Den < 0 then
1248
Num := Num * (Rval.Rbase ** (-Rval.Den));
1250
Den := Den * (Rval.Rbase ** Rval.Den);
1253
return Store_Ureal (
1258
Negative => Rneg)));
1267
function UR_Ne (Left, Right : Ureal) return Boolean is
1269
-- Quick processing for case of identical Ureal values (note that
1270
-- this also deals with comparing two No_Ureal values).
1272
if Same (Left, Right) then
1275
-- Deal with case of one or other operand is No_Ureal, but not both
1277
elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
1280
-- Do quick check based on number of decimal digits
1282
elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
1283
Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
1287
-- Otherwise full comparison is required
1291
Imrk : constant Uintp.Save_Mark := Mark;
1292
Rmrk : constant Urealp.Save_Mark := Mark;
1293
Lval : constant Ureal_Entry := Normalize (Ureals.Table (Left));
1294
Rval : constant Ureal_Entry := Normalize (Ureals.Table (Right));
1298
if UR_Is_Zero (Left) then
1299
return not UR_Is_Zero (Right);
1301
elsif UR_Is_Zero (Right) then
1302
return not UR_Is_Zero (Left);
1304
-- Both operands are non-zero
1308
Rval.Negative /= Lval.Negative
1309
or else Rval.Num /= Lval.Num
1310
or else Rval.Den /= Lval.Den;
1323
function UR_Negate (Real : Ureal) return Ureal is
1325
return Store_Ureal (
1326
(Num => Ureals.Table (Real).Num,
1327
Den => Ureals.Table (Real).Den,
1328
Rbase => Ureals.Table (Real).Rbase,
1329
Negative => not Ureals.Table (Real).Negative));
1336
function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
1338
return UR_From_Uint (Left) + UR_Negate (Right);
1341
function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
1343
return Left + UR_From_Uint (-Right);
1346
function UR_Sub (Left, Right : Ureal) return Ureal is
1348
return Left + UR_Negate (Right);
1355
function UR_To_Uint (Real : Ureal) return Uint is
1356
Val : Ureal_Entry := Normalize (Ureals.Table (Real));
1360
Res := (Val.Num + (Val.Den / 2)) / Val.Den;
1362
if Val.Negative then
1363
return UI_Negate (Res);
1373
function UR_Trunc (Real : Ureal) return Uint is
1374
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1377
if Val.Negative then
1378
return -(Val.Num / Val.Den);
1380
return Val.Num / Val.Den;
1388
procedure UR_Write (Real : Ureal) is
1389
Val : constant Ureal_Entry := Ureals.Table (Real);
1392
-- If value is negative, we precede the constant by a minus sign
1393
-- and add an extra layer of parentheses on the outside since the
1394
-- minus sign is part of the value, not a negation operator.
1396
if Val.Negative then
1400
-- Constants in base 10 can be written in normal Ada literal style
1401
-- If the literal is negative enclose in parens to emphasize that
1402
-- it is part of the constant, and not a separate negation operator
1404
if Val.Rbase = 10 then
1406
UI_Write (Val.Num / 10);
1408
UI_Write (Val.Num mod 10);
1410
if Val.Den /= 0 then
1412
UI_Write (1 - Val.Den);
1415
-- Constants in a base other than 10 can still be easily written
1416
-- in normal Ada literal style if the numerator is one.
1418
elsif Val.Rbase /= 0 and then Val.Num = 1 then
1419
Write_Int (Val.Rbase);
1420
Write_Str ("#1.0#E");
1421
UI_Write (-Val.Den);
1423
-- Other constants with a base other than 10 are written using one
1424
-- of the following forms, depending on the sign of the number
1425
-- and the sign of the exponent (= minus denominator value)
1427
-- (numerator.0*base**exponent)
1428
-- (numerator.0*base**(-exponent))
1430
elsif Val.Rbase /= 0 then
1432
UI_Write (Val.Num, Decimal);
1434
Write_Int (Val.Rbase);
1437
if Val.Den <= 0 then
1438
UI_Write (-Val.Den, Decimal);
1442
UI_Write (Val.Den, Decimal);
1448
-- Rational constants with a denominator of 1 can be written as
1449
-- a real literal for the numerator integer.
1451
elsif Val.Den = 1 then
1452
UI_Write (Val.Num, Decimal);
1455
-- Non-based (rational) constants are written in (num/den) style
1459
UI_Write (Val.Num, Decimal);
1461
UI_Write (Val.Den, Decimal);
1465
-- Add trailing paren for negative values
1467
if Val.Negative then
added
removed
gnat/urealp.adb
