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 ------------------------------------------------------------------------------
34 with Output
; use Output
;
35 with Tree_IO
; use Tree_IO
;
37 with GNAT
.HTable
; use GNAT
.HTable
;
41 ------------------------
42 -- Local Declarations --
43 ------------------------
45 Uint_Int_First
: Uint
:= Uint_0
;
46 -- Uint value containing Int'First value, set by Initialize. The initial
47 -- value of Uint_0 is used for an assertion check that ensures that this
48 -- value is not used before it is initialized. This value is used in the
49 -- UI_Is_In_Int_Range predicate, and it is right that this is a host value,
50 -- since the issue is host representation of integer values.
53 -- Uint value containing Int'Last value set by Initialize
55 UI_Power_2
: array (Int
range 0 .. 64) of Uint
;
56 -- This table is used to memoize exponentiations by powers of 2. The Nth
57 -- entry, if set, contains the Uint value 2 ** N. Initially UI_Power_2_Set
58 -- is zero and only the 0'th entry is set, the invariant being that all
59 -- entries in the range 0 .. UI_Power_2_Set are initialized.
62 -- Number of entries set in UI_Power_2;
64 UI_Power_10
: array (Int
range 0 .. 64) of Uint
;
65 -- This table is used to memoize exponentiations by powers of 10 in the
66 -- same manner as described above for UI_Power_2.
68 UI_Power_10_Set
: Nat
;
69 -- Number of entries set in UI_Power_10;
73 -- These values are used to make sure that the mark/release mechanism does
74 -- not destroy values saved in the U_Power tables or in the hash table used
75 -- by UI_From_Int. Whenever an entry is made in either of these tabls,
76 -- Uints_Min and Udigits_Min are updated to protect the entry, and Release
77 -- never cuts back beyond these minimum values.
79 Int_0
: constant Int
:= 0;
80 Int_1
: constant Int
:= 1;
81 Int_2
: constant Int
:= 2;
82 -- These values are used in some cases where the use of numeric literals
83 -- would cause ambiguities (integer vs Uint).
85 ----------------------------
86 -- UI_From_Int Hash Table --
87 ----------------------------
89 -- UI_From_Int uses a hash table to avoid duplicating entries and wasting
90 -- storage. This is particularly important for complex cases of back
93 subtype Hnum
is Nat
range 0 .. 1022;
95 function Hash_Num
(F
: Int
) return Hnum
;
98 package UI_Ints
is new Simple_HTable
(
101 No_Element
=> No_Uint
,
106 -----------------------
107 -- Local Subprograms --
108 -----------------------
110 function Direct
(U
: Uint
) return Boolean;
111 pragma Inline
(Direct
);
112 -- Returns True if U is represented directly
114 function Direct_Val
(U
: Uint
) return Int
;
115 -- U is a Uint for is represented directly. The returned result is the
116 -- value represented.
118 function GCD
(Jin
, Kin
: Int
) return Int
;
119 -- Compute GCD of two integers. Assumes that Jin >= Kin >= 0
125 -- Common processing for UI_Image and UI_Write, To_Buffer is set True for
126 -- UI_Image, and false for UI_Write, and Format is copied from the Format
127 -- parameter to UI_Image or UI_Write.
129 procedure Init_Operand
(UI
: Uint
; Vec
: out UI_Vector
);
130 pragma Inline
(Init_Operand
);
131 -- This procedure puts the value of UI into the vector in canonical
132 -- multiple precision format. The parameter should be of the correct size
133 -- as determined by a previous call to N_Digits (UI). The first digit of
134 -- Vec contains the sign, all other digits are always non- negative. Note
135 -- that the input may be directly represented, and in this case Vec will
136 -- contain the corresponding one or two digit value. The low bound of Vec
139 function Least_Sig_Digit
(Arg
: Uint
) return Int
;
140 pragma Inline
(Least_Sig_Digit
);
141 -- Returns the Least Significant Digit of Arg quickly. When the given Uint
142 -- is less than 2**15, the value returned is the input value, in this case
143 -- the result may be negative. It is expected that any use will mask off
144 -- unnecessary bits. This is used for finding Arg mod B where B is a power
145 -- of two. Hence the actual base is irrelevent as long as it is a power of
148 procedure Most_Sig_2_Digits
152 Right_Hat
: out Int
);
153 -- Returns leading two significant digits from the given pair of Uint's.
154 -- Mathematically: returns Left / (Base ** K) and Right / (Base ** K) where
155 -- K is as small as possible S.T. Right_Hat < Base * Base. It is required
156 -- that Left > Right for the algorithm to work.
158 function N_Digits
(Input
: Uint
) return Int
;
159 pragma Inline
(N_Digits
);
160 -- Returns number of "digits" in a Uint
162 function Sum_Digits
(Left
: Uint
; Sign
: Int
) return Int
;
163 -- If Sign = 1 return the sum of the "digits" of Abs (Left). If the total
164 -- has more then one digit then return Sum_Digits of total.
166 function Sum_Double_Digits
(Left
: Uint
; Sign
: Int
) return Int
;
167 -- Same as above but work in New_Base = Base * Base
172 Remainder
: out Uint
;
173 Discard_Quotient
: Boolean;
174 Discard_Remainder
: Boolean);
175 -- Compute euclidian division of Left by Right, and return Quotient and
176 -- signed Remainder (Left rem Right).
178 -- If Discard_Quotient is True, Quotient is left unchanged.
179 -- If Discard_Remainder is True, Remainder is left unchanged.
181 function Vector_To_Uint
183 Negative
: Boolean) return Uint
;
184 -- Functions that calculate values in UI_Vectors, call this function to
185 -- create and return the Uint value. In_Vec contains the multiple precision
186 -- (Base) representation of a non-negative value. Leading zeroes are
187 -- permitted. Negative is set if the desired result is the negative of the
188 -- given value. The result will be either the appropriate directly
189 -- represented value, or a table entry in the proper canonical format is
190 -- created and returned.
192 -- Note that Init_Operand puts a signed value in the result vector, but
193 -- Vector_To_Uint is always presented with a non-negative value. The
194 -- processing of signs is something that is done by the caller before
195 -- calling Vector_To_Uint.
201 function Direct
(U
: Uint
) return Boolean is
203 return Int
(U
) <= Int
(Uint_Direct_Last
);
210 function Direct_Val
(U
: Uint
) return Int
is
212 pragma Assert
(Direct
(U
));
213 return Int
(U
) - Int
(Uint_Direct_Bias
);
220 function GCD
(Jin
, Kin
: Int
) return Int
is
224 pragma Assert
(Jin
>= Kin
);
225 pragma Assert
(Kin
>= Int_0
);
229 while K
/= Uint_0
loop
242 function Hash_Num
(F
: Int
) return Hnum
is
244 return Standard
."mod" (F
, Hnum
'Range_Length);
256 Marks
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
260 Digs_Output
: Natural := 0;
261 -- Counts digits output. In hex mode, but not in decimal mode, we
262 -- put an underline after every four hex digits that are output.
264 Exponent
: Natural := 0;
265 -- If the number is too long to fit in the buffer, we switch to an
266 -- approximate output format with an exponent. This variable records
267 -- the exponent value.
269 function Better_In_Hex
return Boolean;
270 -- Determines if it is better to generate digits in base 16 (result
271 -- is true) or base 10 (result is false). The choice is purely a
272 -- matter of convenience and aesthetics, so it does not matter which
273 -- value is returned from a correctness point of view.
275 procedure Image_Char
(C
: Character);
276 -- Internal procedure to output one character
278 procedure Image_Exponent
(N
: Natural);
279 -- Output non-zero exponent. Note that we only use the exponent form in
280 -- the buffer case, so we know that To_Buffer is true.
282 procedure Image_Uint
(U
: Uint
);
283 -- Internal procedure to output characters of non-negative Uint
289 function Better_In_Hex
return Boolean is
290 T16
: constant Uint
:= Uint_2
** Int
'(16);
296 -- Small values up to 2**16 can always be in decimal
302 -- Otherwise, see if we are a power of 2 or one less than a power
303 -- of 2. For the moment these are the only cases printed in hex.
305 if A mod Uint_2 = Uint_1 then
310 if A mod T16 /= Uint_0 then
320 while A > Uint_2 loop
321 if A mod Uint_2 /= Uint_0 then
336 procedure Image_Char (C : Character) is
339 if UI_Image_Length + 6 > UI_Image_Max then
340 Exponent := Exponent + 1;
342 UI_Image_Length := UI_Image_Length + 1;
343 UI_Image_Buffer (UI_Image_Length) := C;
354 procedure Image_Exponent (N : Natural) is
357 Image_Exponent (N / 10);
360 UI_Image_Length := UI_Image_Length + 1;
361 UI_Image_Buffer (UI_Image_Length) :=
362 Character'Val (Character'Pos ('0') + N mod 10);
369 procedure Image_Uint (U : Uint) is
370 H : constant array (Int range 0 .. 15) of Character :=
375 Image_Uint (U / Base);
378 if Digs_Output = 4 and then Base = Uint_16 then
383 Image_Char (H (UI_To_Int (U rem Base)));
385 Digs_Output := Digs_Output + 1;
388 -- Start of processing for Image_Out
391 if Input = No_Uint then
396 UI_Image_Length := 0;
398 if Input < Uint_0 then
406 or else (Format = Auto and then Better_In_Hex)
420 if Exponent /= 0 then
421 UI_Image_Length := UI_Image_Length + 1;
422 UI_Image_Buffer (UI_Image_Length) := 'E
';
423 Image_Exponent (Exponent);
426 Uintp.Release (Marks);
433 procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
436 pragma Assert (Vec'First = Int'(1));
440 Vec
(1) := Direct_Val
(UI
);
442 if Vec
(1) >= Base
then
443 Vec
(2) := Vec
(1) rem Base
;
444 Vec
(1) := Vec
(1) / Base
;
448 Loc
:= Uints
.Table
(UI
).Loc
;
450 for J
in 1 .. Uints
.Table
(UI
).Length
loop
451 Vec
(J
) := Udigits
.Table
(Loc
+ J
- 1);
460 procedure Initialize
is
465 Uint_Int_First
:= UI_From_Int
(Int
'First);
466 Uint_Int_Last
:= UI_From_Int
(Int
'Last);
468 UI_Power_2
(0) := Uint_1
;
471 UI_Power_10
(0) := Uint_1
;
472 UI_Power_10_Set
:= 0;
474 Uints_Min
:= Uints
.Last
;
475 Udigits_Min
:= Udigits
.Last
;
480 ---------------------
481 -- Least_Sig_Digit --
482 ---------------------
484 function Least_Sig_Digit
(Arg
: Uint
) return Int
is
489 V
:= Direct_Val
(Arg
);
495 -- Note that this result may be negative
502 (Uints
.Table
(Arg
).Loc
+ Uints
.Table
(Arg
).Length
- 1);
510 function Mark
return Save_Mark
is
512 return (Save_Uint
=> Uints
.Last
, Save_Udigit
=> Udigits
.Last
);
515 -----------------------
516 -- Most_Sig_2_Digits --
517 -----------------------
519 procedure Most_Sig_2_Digits
526 pragma Assert
(Left
>= Right
);
528 if Direct
(Left
) then
529 Left_Hat
:= Direct_Val
(Left
);
530 Right_Hat
:= Direct_Val
(Right
);
536 Udigits
.Table
(Uints
.Table
(Left
).Loc
);
538 Udigits
.Table
(Uints
.Table
(Left
).Loc
+ 1);
541 -- It is not so clear what to return when Arg is negative???
543 Left_Hat
:= abs (L1
) * Base
+ L2
;
548 Length_L
: constant Int
:= Uints
.Table
(Left
).Length
;
555 if Direct
(Right
) then
556 T
:= Direct_Val
(Left
);
557 R1
:= abs (T
/ Base
);
562 R1
:= abs (Udigits
.Table
(Uints
.Table
(Right
).Loc
));
563 R2
:= Udigits
.Table
(Uints
.Table
(Right
).Loc
+ 1);
564 Length_R
:= Uints
.Table
(Right
).Length
;
567 if Length_L
= Length_R
then
568 Right_Hat
:= R1
* Base
+ R2
;
569 elsif Length_L
= Length_R
+ Int_1
then
575 end Most_Sig_2_Digits
;
581 -- Note: N_Digits returns 1 for No_Uint
583 function N_Digits
(Input
: Uint
) return Int
is
585 if Direct
(Input
) then
586 if Direct_Val
(Input
) >= Base
then
593 return Uints
.Table
(Input
).Length
;
601 function Num_Bits
(Input
: Uint
) return Nat
is
606 -- Largest negative number has to be handled specially, since it is in
607 -- Int_Range, but we cannot take the absolute value.
609 if Input
= Uint_Int_First
then
612 -- For any other number in Int_Range, get absolute value of number
614 elsif UI_Is_In_Int_Range
(Input
) then
615 Num
:= abs (UI_To_Int
(Input
));
618 -- If not in Int_Range then initialize bit count for all low order
619 -- words, and set number to high order digit.
622 Bits
:= Base_Bits
* (Uints
.Table
(Input
).Length
- 1);
623 Num
:= abs (Udigits
.Table
(Uints
.Table
(Input
).Loc
));
626 -- Increase bit count for remaining value in Num
628 while Types
.">" (Num
, 0) loop
640 procedure pid
(Input
: Uint
) is
642 UI_Write
(Input
, Decimal
);
650 procedure pih
(Input
: Uint
) is
652 UI_Write
(Input
, Hex
);
660 procedure Release
(M
: Save_Mark
) is
662 Uints
.Set_Last
(Uint
'Max (M
.Save_Uint
, Uints_Min
));
663 Udigits
.Set_Last
(Int
'Max (M
.Save_Udigit
, Udigits_Min
));
666 ----------------------
667 -- Release_And_Save --
668 ----------------------
670 procedure Release_And_Save
(M
: Save_Mark
; UI
: in out Uint
) is
677 UE_Len
: constant Pos
:= Uints
.Table
(UI
).Length
;
678 UE_Loc
: constant Int
:= Uints
.Table
(UI
).Loc
;
680 UD
: constant Udigits
.Table_Type
(1 .. UE_Len
) :=
681 Udigits
.Table
(UE_Loc
.. UE_Loc
+ UE_Len
- 1);
686 Uints
.Increment_Last
;
689 Uints
.Table
(UI
) := (UE_Len
, Udigits
.Last
+ 1);
691 for J
in 1 .. UE_Len
loop
692 Udigits
.Increment_Last
;
693 Udigits
.Table
(Udigits
.Last
) := UD
(J
);
697 end Release_And_Save
;
699 procedure Release_And_Save
(M
: Save_Mark
; UI1
, UI2
: in out Uint
) is
702 Release_And_Save
(M
, UI2
);
704 elsif Direct
(UI2
) then
705 Release_And_Save
(M
, UI1
);
709 UE1_Len
: constant Pos
:= Uints
.Table
(UI1
).Length
;
710 UE1_Loc
: constant Int
:= Uints
.Table
(UI1
).Loc
;
712 UD1
: constant Udigits
.Table_Type
(1 .. UE1_Len
) :=
713 Udigits
.Table
(UE1_Loc
.. UE1_Loc
+ UE1_Len
- 1);
715 UE2_Len
: constant Pos
:= Uints
.Table
(UI2
).Length
;
716 UE2_Loc
: constant Int
:= Uints
.Table
(UI2
).Loc
;
718 UD2
: constant Udigits
.Table_Type
(1 .. UE2_Len
) :=
719 Udigits
.Table
(UE2_Loc
.. UE2_Loc
+ UE2_Len
- 1);
724 Uints
.Increment_Last
;
727 Uints
.Table
(UI1
) := (UE1_Len
, Udigits
.Last
+ 1);
729 for J
in 1 .. UE1_Len
loop
730 Udigits
.Increment_Last
;
731 Udigits
.Table
(Udigits
.Last
) := UD1
(J
);
734 Uints
.Increment_Last
;
737 Uints
.Table
(UI2
) := (UE2_Len
, Udigits
.Last
+ 1);
739 for J
in 1 .. UE2_Len
loop
740 Udigits
.Increment_Last
;
741 Udigits
.Table
(Udigits
.Last
) := UD2
(J
);
745 end Release_And_Save
;
751 -- This is done in one pass
753 -- Mathematically: assume base congruent to 1 and compute an equivelent
756 -- If Sign = -1 return the alternating sum of the "digits"
758 -- D1 - D2 + D3 - D4 + D5 ...
760 -- (where D1 is Least Significant Digit)
762 -- Mathematically: assume base congruent to -1 and compute an equivelent
765 -- This is used in Rem and Base is assumed to be 2 ** 15
767 -- Note: The next two functions are very similar, any style changes made
768 -- to one should be reflected in both. These would be simpler if we
769 -- worked base 2 ** 32.
771 function Sum_Digits
(Left
: Uint
; Sign
: Int
) return Int
is
773 pragma Assert
(Sign
= Int_1
or Sign
= Int
(-1));
775 -- First try simple case;
777 if Direct
(Left
) then
779 Tmp_Int
: Int
:= Direct_Val
(Left
);
782 if Tmp_Int
>= Base
then
783 Tmp_Int
:= (Tmp_Int
/ Base
) +
784 Sign
* (Tmp_Int
rem Base
);
786 -- Now Tmp_Int is in [-(Base - 1) .. 2 * (Base - 1)]
788 if Tmp_Int
>= Base
then
792 Tmp_Int
:= (Tmp_Int
/ Base
) + 1;
796 -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
803 -- Otherwise full circuit is needed
807 L_Length
: constant Int
:= N_Digits
(Left
);
808 L_Vec
: UI_Vector
(1 .. L_Length
);
814 Init_Operand
(Left
, L_Vec
);
815 L_Vec
(1) := abs L_Vec
(1);
820 for J
in reverse 1 .. L_Length
loop
821 Tmp_Int
:= Tmp_Int
+ Alt
* (L_Vec
(J
) + Carry
);
823 -- Tmp_Int is now between [-2 * Base + 1 .. 2 * Base - 1],
824 -- since old Tmp_Int is between [-(Base - 1) .. Base - 1]
825 -- and L_Vec is in [0 .. Base - 1] and Carry in [-1 .. 1]
827 if Tmp_Int
>= Base
then
828 Tmp_Int
:= Tmp_Int
- Base
;
831 elsif Tmp_Int
<= -Base
then
832 Tmp_Int
:= Tmp_Int
+ Base
;
839 -- Tmp_Int is now between [-Base + 1 .. Base - 1]
844 Tmp_Int
:= Tmp_Int
+ Alt
* Carry
;
846 -- Tmp_Int is now between [-Base .. Base]
848 if Tmp_Int
>= Base
then
849 Tmp_Int
:= Tmp_Int
- Base
+ Alt
* Sign
* 1;
851 elsif Tmp_Int
<= -Base
then
852 Tmp_Int
:= Tmp_Int
+ Base
+ Alt
* Sign
* (-1);
855 -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
862 -----------------------
863 -- Sum_Double_Digits --
864 -----------------------
866 -- Note: This is used in Rem, Base is assumed to be 2 ** 15
868 function Sum_Double_Digits
(Left
: Uint
; Sign
: Int
) return Int
is
870 -- First try simple case;
872 pragma Assert
(Sign
= Int_1
or Sign
= Int
(-1));
874 if Direct
(Left
) then
875 return Direct_Val
(Left
);
877 -- Otherwise full circuit is needed
881 L_Length
: constant Int
:= N_Digits
(Left
);
882 L_Vec
: UI_Vector
(1 .. L_Length
);
890 Init_Operand
(Left
, L_Vec
);
891 L_Vec
(1) := abs L_Vec
(1);
899 Least_Sig_Int
:= Least_Sig_Int
+ Alt
* (L_Vec
(J
) + Carry
);
901 -- Least is in [-2 Base + 1 .. 2 * Base - 1]
902 -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
903 -- and old Least in [-Base + 1 .. Base - 1]
905 if Least_Sig_Int
>= Base
then
906 Least_Sig_Int
:= Least_Sig_Int
- Base
;
909 elsif Least_Sig_Int
<= -Base
then
910 Least_Sig_Int
:= Least_Sig_Int
+ Base
;
917 -- Least is now in [-Base + 1 .. Base - 1]
919 Most_Sig_Int
:= Most_Sig_Int
+ Alt
* (L_Vec
(J
- 1) + Carry
);
921 -- Most is in [-2 Base + 1 .. 2 * Base - 1]
922 -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
923 -- and old Most in [-Base + 1 .. Base - 1]
925 if Most_Sig_Int
>= Base
then
926 Most_Sig_Int
:= Most_Sig_Int
- Base
;
929 elsif Most_Sig_Int
<= -Base
then
930 Most_Sig_Int
:= Most_Sig_Int
+ Base
;
936 -- Most is now in [-Base + 1 .. Base - 1]
943 Least_Sig_Int
:= Least_Sig_Int
+ Alt
* (L_Vec
(J
) + Carry
);
945 Least_Sig_Int
:= Least_Sig_Int
+ Alt
* Carry
;
948 if Least_Sig_Int
>= Base
then
949 Least_Sig_Int
:= Least_Sig_Int
- Base
;
950 Most_Sig_Int
:= Most_Sig_Int
+ Alt
* 1;
952 elsif Least_Sig_Int
<= -Base
then
953 Least_Sig_Int
:= Least_Sig_Int
+ Base
;
954 Most_Sig_Int
:= Most_Sig_Int
+ Alt
* (-1);
957 if Most_Sig_Int
>= Base
then
958 Most_Sig_Int
:= Most_Sig_Int
- Base
;
961 Least_Sig_Int
+ Alt
* 1; -- cannot overflow again
963 elsif Most_Sig_Int
<= -Base
then
964 Most_Sig_Int
:= Most_Sig_Int
+ Base
;
967 Least_Sig_Int
+ Alt
* (-1); -- cannot overflow again.
970 return Most_Sig_Int
* Base
+ Least_Sig_Int
;
973 end Sum_Double_Digits
;
979 procedure Tree_Read
is
984 Tree_Read_Int
(Int
(Uint_Int_First
));
985 Tree_Read_Int
(Int
(Uint_Int_Last
));
986 Tree_Read_Int
(UI_Power_2_Set
);
987 Tree_Read_Int
(UI_Power_10_Set
);
988 Tree_Read_Int
(Int
(Uints_Min
));
989 Tree_Read_Int
(Udigits_Min
);
991 for J
in 0 .. UI_Power_2_Set
loop
992 Tree_Read_Int
(Int
(UI_Power_2
(J
)));
995 for J
in 0 .. UI_Power_10_Set
loop
996 Tree_Read_Int
(Int
(UI_Power_10
(J
)));
1005 procedure Tree_Write
is
1010 Tree_Write_Int
(Int
(Uint_Int_First
));
1011 Tree_Write_Int
(Int
(Uint_Int_Last
));
1012 Tree_Write_Int
(UI_Power_2_Set
);
1013 Tree_Write_Int
(UI_Power_10_Set
);
1014 Tree_Write_Int
(Int
(Uints_Min
));
1015 Tree_Write_Int
(Udigits_Min
);
1017 for J
in 0 .. UI_Power_2_Set
loop
1018 Tree_Write_Int
(Int
(UI_Power_2
(J
)));
1021 for J
in 0 .. UI_Power_10_Set
loop
1022 Tree_Write_Int
(Int
(UI_Power_10
(J
)));
1031 function UI_Abs
(Right
: Uint
) return Uint
is
1033 if Right
< Uint_0
then
1044 function UI_Add
(Left
: Int
; Right
: Uint
) return Uint
is
1046 return UI_Add
(UI_From_Int
(Left
), Right
);
1049 function UI_Add
(Left
: Uint
; Right
: Int
) return Uint
is
1051 return UI_Add
(Left
, UI_From_Int
(Right
));
1054 function UI_Add
(Left
: Uint
; Right
: Uint
) return Uint
is
1056 -- Simple cases of direct operands and addition of zero
1058 if Direct
(Left
) then
1059 if Direct
(Right
) then
1060 return UI_From_Int
(Direct_Val
(Left
) + Direct_Val
(Right
));
1062 elsif Int
(Left
) = Int
(Uint_0
) then
1066 elsif Direct
(Right
) and then Int
(Right
) = Int
(Uint_0
) then
1070 -- Otherwise full circuit is needed
1073 L_Length
: constant Int
:= N_Digits
(Left
);
1074 R_Length
: constant Int
:= N_Digits
(Right
);
1075 L_Vec
: UI_Vector
(1 .. L_Length
);
1076 R_Vec
: UI_Vector
(1 .. R_Length
);
1081 X_Bigger
: Boolean := False;
1082 Y_Bigger
: Boolean := False;
1083 Result_Neg
: Boolean := False;
1086 Init_Operand
(Left
, L_Vec
);
1087 Init_Operand
(Right
, R_Vec
);
1089 -- At least one of the two operands is in multi-digit form.
1090 -- Calculate the number of digits sufficient to hold result.
1092 if L_Length
> R_Length
then
1093 Sum_Length
:= L_Length
+ 1;
1096 Sum_Length
:= R_Length
+ 1;
1098 if R_Length
> L_Length
then
1103 -- Make copies of the absolute values of L_Vec and R_Vec into X and Y
1104 -- both with lengths equal to the maximum possibly needed. This makes
1105 -- looping over the digits much simpler.
1108 X
: UI_Vector
(1 .. Sum_Length
);
1109 Y
: UI_Vector
(1 .. Sum_Length
);
1110 Tmp_UI
: UI_Vector
(1 .. Sum_Length
);
1113 for J
in 1 .. Sum_Length
- L_Length
loop
1117 X
(Sum_Length
- L_Length
+ 1) := abs L_Vec
(1);
1119 for J
in 2 .. L_Length
loop
1120 X
(J
+ (Sum_Length
- L_Length
)) := L_Vec
(J
);
1123 for J
in 1 .. Sum_Length
- R_Length
loop
1127 Y
(Sum_Length
- R_Length
+ 1) := abs R_Vec
(1);
1129 for J
in 2 .. R_Length
loop
1130 Y
(J
+ (Sum_Length
- R_Length
)) := R_Vec
(J
);
1133 if (L_Vec
(1) < Int_0
) = (R_Vec
(1) < Int_0
) then
1135 -- Same sign so just add
1138 for J
in reverse 1 .. Sum_Length
loop
1139 Tmp_Int
:= X
(J
) + Y
(J
) + Carry
;
1141 if Tmp_Int
>= Base
then
1142 Tmp_Int
:= Tmp_Int
- Base
;
1151 return Vector_To_Uint
(X
, L_Vec
(1) < Int_0
);
1154 -- Find which one has bigger magnitude
1156 if not (X_Bigger
or Y_Bigger
) then
1157 for J
in L_Vec
'Range loop
1158 if abs L_Vec
(J
) > abs R_Vec
(J
) then
1161 elsif abs R_Vec
(J
) > abs L_Vec
(J
) then
1168 -- If they have identical magnitude, just return 0, else swap
1169 -- if necessary so that X had the bigger magnitude. Determine
1170 -- if result is negative at this time.
1172 Result_Neg
:= False;
1174 if not (X_Bigger
or Y_Bigger
) then
1178 if R_Vec
(1) < Int_0
then
1187 if L_Vec
(1) < Int_0
then
1192 -- Subtract Y from the bigger X
1196 for J
in reverse 1 .. Sum_Length
loop
1197 Tmp_Int
:= X
(J
) - Y
(J
) + Borrow
;
1199 if Tmp_Int
< Int_0
then
1200 Tmp_Int
:= Tmp_Int
+ Base
;
1209 return Vector_To_Uint
(X
, Result_Neg
);
1216 --------------------------
1217 -- UI_Decimal_Digits_Hi --
1218 --------------------------
1220 function UI_Decimal_Digits_Hi
(U
: Uint
) return Nat
is
1222 -- The maximum value of a "digit" is 32767, which is 5 decimal digits,
1223 -- so an N_Digit number could take up to 5 times this number of digits.
1224 -- This is certainly too high for large numbers but it is not worth
1227 return 5 * N_Digits
(U
);
1228 end UI_Decimal_Digits_Hi
;
1230 --------------------------
1231 -- UI_Decimal_Digits_Lo --
1232 --------------------------
1234 function UI_Decimal_Digits_Lo
(U
: Uint
) return Nat
is
1236 -- The maximum value of a "digit" is 32767, which is more than four
1237 -- decimal digits, but not a full five digits. The easily computed
1238 -- minimum number of decimal digits is thus 1 + 4 * the number of
1239 -- digits. This is certainly too low for large numbers but it is not
1240 -- worth worrying about.
1242 return 1 + 4 * (N_Digits
(U
) - 1);
1243 end UI_Decimal_Digits_Lo
;
1249 function UI_Div
(Left
: Int
; Right
: Uint
) return Uint
is
1251 return UI_Div
(UI_From_Int
(Left
), Right
);
1254 function UI_Div
(Left
: Uint
; Right
: Int
) return Uint
is
1256 return UI_Div
(Left
, UI_From_Int
(Right
));
1259 function UI_Div
(Left
, Right
: Uint
) return Uint
is
1265 Quotient
, Remainder
,
1266 Discard_Quotient
=> False,
1267 Discard_Remainder
=> True);
1275 procedure UI_Div_Rem
1276 (Left
, Right
: Uint
;
1277 Quotient
: out Uint
;
1278 Remainder
: out Uint
;
1279 Discard_Quotient
: Boolean;
1280 Discard_Remainder
: Boolean)
1283 pragma Assert
(Right
/= Uint_0
);
1285 -- Cases where both operands are represented directly
1287 if Direct
(Left
) and then Direct
(Right
) then
1289 DV_Left
: constant Int
:= Direct_Val
(Left
);
1290 DV_Right
: constant Int
:= Direct_Val
(Right
);
1293 if not Discard_Quotient
then
1294 Quotient
:= UI_From_Int
(DV_Left
/ DV_Right
);
1297 if not Discard_Remainder
then
1298 Remainder
:= UI_From_Int
(DV_Left
rem DV_Right
);
1306 L_Length
: constant Int
:= N_Digits
(Left
);
1307 R_Length
: constant Int
:= N_Digits
(Right
);
1308 Q_Length
: constant Int
:= L_Length
- R_Length
+ 1;
1309 L_Vec
: UI_Vector
(1 .. L_Length
);
1310 R_Vec
: UI_Vector
(1 .. R_Length
);
1318 procedure UI_Div_Vector
1321 Quotient
: out UI_Vector
;
1322 Remainder
: out Int
);
1323 pragma Inline
(UI_Div_Vector
);
1324 -- Specialised variant for case where the divisor is a single digit
1326 procedure UI_Div_Vector
1329 Quotient
: out UI_Vector
;
1330 Remainder
: out Int
)
1336 for J
in L_Vec
'Range loop
1337 Tmp_Int
:= Remainder
* Base
+ abs L_Vec
(J
);
1338 Quotient
(Quotient
'First + J
- L_Vec
'First) := Tmp_Int
/ R_Int
;
1339 Remainder
:= Tmp_Int
rem R_Int
;
1342 if L_Vec
(L_Vec
'First) < Int_0
then
1343 Remainder
:= -Remainder
;
1347 -- Start of processing for UI_Div_Rem
1350 -- Result is zero if left operand is shorter than right
1352 if L_Length
< R_Length
then
1353 if not Discard_Quotient
then
1356 if not Discard_Remainder
then
1362 Init_Operand
(Left
, L_Vec
);
1363 Init_Operand
(Right
, R_Vec
);
1365 -- Case of right operand is single digit. Here we can simply divide
1366 -- each digit of the left operand by the divisor, from most to least
1367 -- significant, carrying the remainder to the next digit (just like
1368 -- ordinary long division by hand).
1370 if R_Length
= Int_1
then
1371 Tmp_Divisor
:= abs R_Vec
(1);
1374 Quotient_V
: UI_Vector
(1 .. L_Length
);
1377 UI_Div_Vector
(L_Vec
, Tmp_Divisor
, Quotient_V
, Remainder_I
);
1379 if not Discard_Quotient
then
1382 (Quotient_V
, (L_Vec
(1) < Int_0
xor R_Vec
(1) < Int_0
));
1385 if not Discard_Remainder
then
1386 Remainder
:= UI_From_Int
(Remainder_I
);
1392 -- The possible simple cases have been exhausted. Now turn to the
1393 -- algorithm D from the section of Knuth mentioned at the top of
1396 Algorithm_D
: declare
1397 Dividend
: UI_Vector
(1 .. L_Length
+ 1);
1398 Divisor
: UI_Vector
(1 .. R_Length
);
1399 Quotient_V
: UI_Vector
(1 .. Q_Length
);
1405 -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1406 -- scale d, and then multiply Left and Right (u and v in the book)
1407 -- by d to get the dividend and divisor to work with.
1409 D
:= Base
/ (abs R_Vec
(1) + 1);
1412 Dividend
(2) := abs L_Vec
(1);
1414 for J
in 3 .. L_Length
+ Int_1
loop
1415 Dividend
(J
) := L_Vec
(J
- 1);
1418 Divisor
(1) := abs R_Vec
(1);
1420 for J
in Int_2
.. R_Length
loop
1421 Divisor
(J
) := R_Vec
(J
);
1426 -- Multiply Dividend by D
1429 for J
in reverse Dividend
'Range loop
1430 Tmp_Int
:= Dividend
(J
) * D
+ Carry
;
1431 Dividend
(J
) := Tmp_Int
rem Base
;
1432 Carry
:= Tmp_Int
/ Base
;
1435 -- Multiply Divisor by d
1438 for J
in reverse Divisor
'Range loop
1439 Tmp_Int
:= Divisor
(J
) * D
+ Carry
;
1440 Divisor
(J
) := Tmp_Int
rem Base
;
1441 Carry
:= Tmp_Int
/ Base
;
1445 -- Main loop of long division algorithm
1447 Divisor_Dig1
:= Divisor
(1);
1448 Divisor_Dig2
:= Divisor
(2);
1450 for J
in Quotient_V
'Range loop
1452 -- [ CALCULATE Q (hat) ] (step D3 in the algorithm)
1454 Tmp_Int
:= Dividend
(J
) * Base
+ Dividend
(J
+ 1);
1458 if Dividend
(J
) = Divisor_Dig1
then
1459 Q_Guess
:= Base
- 1;
1461 Q_Guess
:= Tmp_Int
/ Divisor_Dig1
;
1466 while Divisor_Dig2
* Q_Guess
>
1467 (Tmp_Int
- Q_Guess
* Divisor_Dig1
) * Base
+
1470 Q_Guess
:= Q_Guess
- 1;
1473 -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
1474 -- subtracted from the remaining dividend.
1477 for K
in reverse Divisor
'Range loop
1478 Tmp_Int
:= Dividend
(J
+ K
) - Q_Guess
* Divisor
(K
) + Carry
;
1479 Tmp_Dig
:= Tmp_Int
rem Base
;
1480 Carry
:= Tmp_Int
/ Base
;
1482 if Tmp_Dig
< Int_0
then
1483 Tmp_Dig
:= Tmp_Dig
+ Base
;
1487 Dividend
(J
+ K
) := Tmp_Dig
;
1490 Dividend
(J
) := Dividend
(J
) + Carry
;
1492 -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
1494 -- Here there is a slight difference from the book: the last
1495 -- carry is always added in above and below (cancelling each
1496 -- other). In fact the dividend going negative is used as
1499 -- If the Dividend went negative, then Q_Guess was off by
1500 -- one, so it is decremented, and the divisor is added back
1501 -- into the relevant portion of the dividend.
1503 if Dividend
(J
) < Int_0
then
1504 Q_Guess
:= Q_Guess
- 1;
1507 for K
in reverse Divisor
'Range loop
1508 Tmp_Int
:= Dividend
(J
+ K
) + Divisor
(K
) + Carry
;
1510 if Tmp_Int
>= Base
then
1511 Tmp_Int
:= Tmp_Int
- Base
;
1517 Dividend
(J
+ K
) := Tmp_Int
;
1520 Dividend
(J
) := Dividend
(J
) + Carry
;
1523 -- Finally we can get the next quotient digit
1525 Quotient_V
(J
) := Q_Guess
;
1528 -- [ UNNORMALIZE ] (step D8)
1530 if not Discard_Quotient
then
1531 Quotient
:= Vector_To_Uint
1532 (Quotient_V
, (L_Vec
(1) < Int_0
xor R_Vec
(1) < Int_0
));
1535 if not Discard_Remainder
then
1537 Remainder_V
: UI_Vector
(1 .. R_Length
);
1541 (Dividend
(Dividend
'Last - R_Length
+ 1 .. Dividend
'Last),
1543 Remainder_V
, Discard_Int
);
1544 Remainder
:= Vector_To_Uint
(Remainder_V
, L_Vec
(1) < Int_0
);
1555 function UI_Eq
(Left
: Int
; Right
: Uint
) return Boolean is
1557 return not UI_Ne
(UI_From_Int
(Left
), Right
);
1560 function UI_Eq
(Left
: Uint
; Right
: Int
) return Boolean is
1562 return not UI_Ne
(Left
, UI_From_Int
(Right
));
1565 function UI_Eq
(Left
: Uint
; Right
: Uint
) return Boolean is
1567 return not UI_Ne
(Left
, Right
);
1574 function UI_Expon
(Left
: Int
; Right
: Uint
) return Uint
is
1576 return UI_Expon
(UI_From_Int
(Left
), Right
);
1579 function UI_Expon
(Left
: Uint
; Right
: Int
) return Uint
is
1581 return UI_Expon
(Left
, UI_From_Int
(Right
));
1584 function UI_Expon
(Left
: Int
; Right
: Int
) return Uint
is
1586 return UI_Expon
(UI_From_Int
(Left
), UI_From_Int
(Right
));
1589 function UI_Expon
(Left
: Uint
; Right
: Uint
) return Uint
is
1591 pragma Assert
(Right
>= Uint_0
);
1593 -- Any value raised to power of 0 is 1
1595 if Right
= Uint_0
then
1598 -- 0 to any positive power is 0
1600 elsif Left
= Uint_0
then
1603 -- 1 to any power is 1
1605 elsif Left
= Uint_1
then
1608 -- Any value raised to power of 1 is that value
1610 elsif Right
= Uint_1
then
1613 -- Cases which can be done by table lookup
1615 elsif Right
<= Uint_64
then
1617 -- 2 ** N for N in 2 .. 64
1619 if Left
= Uint_2
then
1621 Right_Int
: constant Int
:= Direct_Val
(Right
);
1624 if Right_Int
> UI_Power_2_Set
then
1625 for J
in UI_Power_2_Set
+ Int_1
.. Right_Int
loop
1626 UI_Power_2
(J
) := UI_Power_2
(J
- Int_1
) * Int_2
;
1627 Uints_Min
:= Uints
.Last
;
1628 Udigits_Min
:= Udigits
.Last
;
1631 UI_Power_2_Set
:= Right_Int
;
1634 return UI_Power_2
(Right_Int
);
1637 -- 10 ** N for N in 2 .. 64
1639 elsif Left
= Uint_10
then
1641 Right_Int
: constant Int
:= Direct_Val
(Right
);
1644 if Right_Int
> UI_Power_10_Set
then
1645 for J
in UI_Power_10_Set
+ Int_1
.. Right_Int
loop
1646 UI_Power_10
(J
) := UI_Power_10
(J
- Int_1
) * Int
(10);
1647 Uints_Min
:= Uints
.Last
;
1648 Udigits_Min
:= Udigits
.Last
;
1651 UI_Power_10_Set
:= Right_Int
;
1654 return UI_Power_10
(Right_Int
);
1659 -- If we fall through, then we have the general case (see Knuth 4.6.3)
1663 Squares
: Uint
:= Left
;
1664 Result
: Uint
:= Uint_1
;
1665 M
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
1669 if (Least_Sig_Digit
(N
) mod Int_2
) = Int_1
then
1670 Result
:= Result
* Squares
;
1674 exit when N
= Uint_0
;
1675 Squares
:= Squares
* Squares
;
1678 Uintp
.Release_And_Save
(M
, Result
);
1687 function UI_From_CC
(Input
: Char_Code
) return Uint
is
1689 return UI_From_Dint
(Dint
(Input
));
1696 function UI_From_Dint
(Input
: Dint
) return Uint
is
1699 if Dint
(Min_Direct
) <= Input
and then Input
<= Dint
(Max_Direct
) then
1700 return Uint
(Dint
(Uint_Direct_Bias
) + Input
);
1702 -- For values of larger magnitude, compute digits into a vector and call
1707 Max_For_Dint
: constant := 5;
1708 -- Base is defined so that 5 Uint digits is sufficient to hold the
1709 -- largest possible Dint value.
1711 V
: UI_Vector
(1 .. Max_For_Dint
);
1713 Temp_Integer
: Dint
;
1716 for J
in V
'Range loop
1720 Temp_Integer
:= Input
;
1722 for J
in reverse V
'Range loop
1723 V
(J
) := Int
(abs (Temp_Integer
rem Dint
(Base
)));
1724 Temp_Integer
:= Temp_Integer
/ Dint
(Base
);
1727 return Vector_To_Uint
(V
, Input
< Dint
'(0));
1736 function UI_From_Int (Input : Int) return Uint is
1740 if Min_Direct <= Input and then Input <= Max_Direct then
1741 return Uint (Int (Uint_Direct_Bias) + Input);
1744 -- If already in the hash table, return entry
1746 U := UI_Ints.Get (Input);
1748 if U /= No_Uint then
1752 -- For values of larger magnitude, compute digits into a vector and call
1756 Max_For_Int : constant := 3;
1757 -- Base is defined so that 3 Uint digits is sufficient to hold the
1758 -- largest possible Int value.
1760 V : UI_Vector (1 .. Max_For_Int);
1765 for J in V'Range loop
1769 Temp_Integer := Input;
1771 for J in reverse V'Range loop
1772 V (J) := abs (Temp_Integer rem Base);
1773 Temp_Integer := Temp_Integer / Base;
1776 U := Vector_To_Uint (V, Input < Int_0);
1777 UI_Ints.Set (Input, U);
1778 Uints_Min := Uints.Last;
1779 Udigits_Min := Udigits.Last;
1788 -- Lehmer's algorithm for GCD
1790 -- The idea is to avoid using multiple precision arithmetic wherever
1791 -- possible, substituting Int arithmetic instead. See Knuth volume II,
1792 -- Algorithm L (page 329).
1794 -- We use the same notation as Knuth (U_Hat standing for the obvious!)
1796 function UI_GCD (Uin, Vin : Uint) return Uint is
1798 -- Copies of Uin and Vin
1801 -- The most Significant digits of U,V
1803 A, B, C, D, T, Q, Den1, Den2 : Int;
1806 Marks : constant Uintp.Save_Mark := Uintp.Mark;
1807 Iterations : Integer := 0;
1810 pragma Assert (Uin >= Vin);
1811 pragma Assert (Vin >= Uint_0);
1817 Iterations := Iterations + 1;
1824 UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V)));
1828 Most_Sig_2_Digits (U, V, U_Hat, V_Hat);
1835 -- We might overflow and get division by zero here. This just
1836 -- means we cannot take the single precision step
1840 exit when (Den1 * Den2) = Int_0;
1842 -- Compute Q, the trial quotient
1844 Q := (U_Hat + A) / Den1;
1846 exit when Q /= ((U_Hat + B) / Den2);
1848 -- A single precision step Euclid step will give same answer as a
1849 -- multiprecision one.
1859 T := U_Hat - (Q * V_Hat);
1865 -- Take a multiprecision Euclid step
1869 -- No single precision steps take a regular Euclid step
1876 -- Use prior single precision steps to compute this Euclid step
1878 -- For constructs such as:
1879 -- sqrt_2: constant := 1.41421_35623_73095_04880_16887_24209_698;
1880 -- sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2)
1881 -- ** long_float'machine_mantissa;
1883 -- we spend 80% of our time working on this step. Perhaps we need
1884 -- a special case Int / Uint dot product to speed things up. ???
1886 -- Alternatively we could increase the single precision iterations
1887 -- to handle Uint's of some small size ( <5 digits?). Then we
1888 -- would have more iterations on small Uint. On the code above, we
1889 -- only get 5 (on average) single precision iterations per large
1892 Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V);
1893 V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V);
1897 -- If the operands are very different in magnitude, the loop will
1898 -- generate large amounts of short-lived data, which it is worth
1899 -- removing periodically.
1901 if Iterations > 100 then
1902 Release_And_Save (Marks, U, V);
1912 function UI_Ge (Left : Int; Right : Uint) return Boolean is
1914 return not UI_Lt (UI_From_Int (Left), Right);
1917 function UI_Ge (Left : Uint; Right : Int) return Boolean is
1919 return not UI_Lt (Left, UI_From_Int (Right));
1922 function UI_Ge (Left : Uint; Right : Uint) return Boolean is
1924 return not UI_Lt (Left, Right);
1931 function UI_Gt (Left : Int; Right : Uint) return Boolean is
1933 return UI_Lt (Right, UI_From_Int (Left));
1936 function UI_Gt (Left : Uint; Right : Int) return Boolean is
1938 return UI_Lt (UI_From_Int (Right), Left);
1941 function UI_Gt (Left : Uint; Right : Uint) return Boolean is
1943 return UI_Lt (Right, Left);
1950 procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
1952 Image_Out (Input, True, Format);
1955 -------------------------
1956 -- UI_Is_In_Int_Range --
1957 -------------------------
1959 function UI_Is_In_Int_Range (Input : Uint) return Boolean is
1961 -- Make sure we don't get called before Initialize
1963 pragma Assert (Uint_Int_First /= Uint_0);
1965 if Direct (Input) then
1968 return Input >= Uint_Int_First
1969 and then Input <= Uint_Int_Last;
1971 end UI_Is_In_Int_Range;
1977 function UI_Le (Left : Int; Right : Uint) return Boolean is
1979 return not UI_Lt (Right, UI_From_Int (Left));
1982 function UI_Le (Left : Uint; Right : Int) return Boolean is
1984 return not UI_Lt (UI_From_Int (Right), Left);
1987 function UI_Le (Left : Uint; Right : Uint) return Boolean is
1989 return not UI_Lt (Right, Left);
1996 function UI_Lt (Left : Int; Right : Uint) return Boolean is
1998 return UI_Lt (UI_From_Int (Left), Right);
2001 function UI_Lt (Left : Uint; Right : Int) return Boolean is
2003 return UI_Lt (Left, UI_From_Int (Right));
2006 function UI_Lt (Left : Uint; Right : Uint) return Boolean is
2008 -- Quick processing for identical arguments
2010 if Int (Left) = Int (Right) then
2013 -- Quick processing for both arguments directly represented
2015 elsif Direct (Left) and then Direct (Right) then
2016 return Int (Left) < Int (Right);
2018 -- At least one argument is more than one digit long
2022 L_Length : constant Int := N_Digits (Left);
2023 R_Length : constant Int := N_Digits (Right);
2025 L_Vec : UI_Vector (1 .. L_Length);
2026 R_Vec : UI_Vector (1 .. R_Length);
2029 Init_Operand (Left, L_Vec);
2030 Init_Operand (Right, R_Vec);
2032 if L_Vec (1) < Int_0 then
2034 -- First argument negative, second argument non-negative
2036 if R_Vec (1) >= Int_0 then
2039 -- Both arguments negative
2042 if L_Length /= R_Length then
2043 return L_Length > R_Length;
2045 elsif L_Vec (1) /= R_Vec (1) then
2046 return L_Vec (1) < R_Vec (1);
2049 for J in 2 .. L_Vec'Last loop
2050 if L_Vec (J) /= R_Vec (J) then
2051 return L_Vec (J) > R_Vec (J);
2060 -- First argument non-negative, second argument negative
2062 if R_Vec (1) < Int_0 then
2065 -- Both arguments non-negative
2068 if L_Length /= R_Length then
2069 return L_Length < R_Length;
2071 for J in L_Vec'Range loop
2072 if L_Vec (J) /= R_Vec (J) then
2073 return L_Vec (J) < R_Vec (J);
2089 function UI_Max (Left : Int; Right : Uint) return Uint is
2091 return UI_Max (UI_From_Int (Left), Right);
2094 function UI_Max (Left : Uint; Right : Int) return Uint is
2096 return UI_Max (Left, UI_From_Int (Right));
2099 function UI_Max (Left : Uint; Right : Uint) return Uint is
2101 if Left >= Right then
2112 function UI_Min (Left : Int; Right : Uint) return Uint is
2114 return UI_Min (UI_From_Int (Left), Right);
2117 function UI_Min (Left : Uint; Right : Int) return Uint is
2119 return UI_Min (Left, UI_From_Int (Right));
2122 function UI_Min (Left : Uint; Right : Uint) return Uint is
2124 if Left <= Right then
2135 function UI_Mod (Left : Int; Right : Uint) return Uint is
2137 return UI_Mod (UI_From_Int (Left), Right);
2140 function UI_Mod (Left : Uint; Right : Int) return Uint is
2142 return UI_Mod (Left, UI_From_Int (Right));
2145 function UI_Mod (Left : Uint; Right : Uint) return Uint is
2146 Urem : constant Uint := Left rem Right;
2149 if (Left < Uint_0) = (Right < Uint_0)
2150 or else Urem = Uint_0
2154 return Right + Urem;
2158 -------------------------------
2159 -- UI_Modular_Exponentiation --
2160 -------------------------------
2162 function UI_Modular_Exponentiation
2165 Modulo : Uint) return Uint
2167 M : constant Save_Mark := Mark;
2169 Result : Uint := Uint_1;
2171 Exponent : Uint := E;
2174 while Exponent /= Uint_0 loop
2175 if Least_Sig_Digit (Exponent) rem Int'(2) = Int
'(1) then
2176 Result := (Result * Base) rem Modulo;
2179 Exponent := Exponent / Uint_2;
2180 Base := (Base * Base) rem Modulo;
2183 Release_And_Save (M, Result);
2185 end UI_Modular_Exponentiation;
2187 ------------------------
2188 -- UI_Modular_Inverse --
2189 ------------------------
2191 function UI_Modular_Inverse (N : Uint; Modulo : Uint) return Uint is
2192 M : constant Save_Mark := Mark;
2212 Quotient => Q, Remainder => R,
2213 Discard_Quotient => False,
2214 Discard_Remainder => False);
2224 exit when R = Uint_1;
2227 if S = Int'(-1) then
2231 Release_And_Save
(M
, X
);
2233 end UI_Modular_Inverse
;
2239 function UI_Mul
(Left
: Int
; Right
: Uint
) return Uint
is
2241 return UI_Mul
(UI_From_Int
(Left
), Right
);
2244 function UI_Mul
(Left
: Uint
; Right
: Int
) return Uint
is
2246 return UI_Mul
(Left
, UI_From_Int
(Right
));
2249 function UI_Mul
(Left
: Uint
; Right
: Uint
) return Uint
is
2251 -- Simple case of single length operands
2253 if Direct
(Left
) and then Direct
(Right
) then
2256 (Dint
(Direct_Val
(Left
)) * Dint
(Direct_Val
(Right
)));
2259 -- Otherwise we have the general case (Algorithm M in Knuth)
2262 L_Length
: constant Int
:= N_Digits
(Left
);
2263 R_Length
: constant Int
:= N_Digits
(Right
);
2264 L_Vec
: UI_Vector
(1 .. L_Length
);
2265 R_Vec
: UI_Vector
(1 .. R_Length
);
2269 Init_Operand
(Left
, L_Vec
);
2270 Init_Operand
(Right
, R_Vec
);
2271 Neg
:= (L_Vec
(1) < Int_0
) xor (R_Vec
(1) < Int_0
);
2272 L_Vec
(1) := abs (L_Vec
(1));
2273 R_Vec
(1) := abs (R_Vec
(1));
2275 Algorithm_M
: declare
2276 Product
: UI_Vector
(1 .. L_Length
+ R_Length
);
2281 for J
in Product
'Range loop
2285 for J
in reverse R_Vec
'Range loop
2287 for K
in reverse L_Vec
'Range loop
2289 L_Vec
(K
) * R_Vec
(J
) + Product
(J
+ K
) + Carry
;
2290 Product
(J
+ K
) := Tmp_Sum
rem Base
;
2291 Carry
:= Tmp_Sum
/ Base
;
2294 Product
(J
) := Carry
;
2297 return Vector_To_Uint
(Product
, Neg
);
2306 function UI_Ne
(Left
: Int
; Right
: Uint
) return Boolean is
2308 return UI_Ne
(UI_From_Int
(Left
), Right
);
2311 function UI_Ne
(Left
: Uint
; Right
: Int
) return Boolean is
2313 return UI_Ne
(Left
, UI_From_Int
(Right
));
2316 function UI_Ne
(Left
: Uint
; Right
: Uint
) return Boolean is
2318 -- Quick processing for identical arguments. Note that this takes
2319 -- care of the case of two No_Uint arguments.
2321 if Int
(Left
) = Int
(Right
) then
2325 -- See if left operand directly represented
2327 if Direct
(Left
) then
2329 -- If right operand directly represented then compare
2331 if Direct
(Right
) then
2332 return Int
(Left
) /= Int
(Right
);
2334 -- Left operand directly represented, right not, must be unequal
2340 -- Right operand directly represented, left not, must be unequal
2342 elsif Direct
(Right
) then
2346 -- Otherwise both multi-word, do comparison
2349 Size
: constant Int
:= N_Digits
(Left
);
2354 if Size
/= N_Digits
(Right
) then
2358 Left_Loc
:= Uints
.Table
(Left
).Loc
;
2359 Right_Loc
:= Uints
.Table
(Right
).Loc
;
2361 for J
in Int_0
.. Size
- Int_1
loop
2362 if Udigits
.Table
(Left_Loc
+ J
) /=
2363 Udigits
.Table
(Right_Loc
+ J
)
2377 function UI_Negate
(Right
: Uint
) return Uint
is
2379 -- Case where input is directly represented. Note that since the range
2380 -- of Direct values is non-symmetrical, the result may not be directly
2381 -- represented, this is taken care of in UI_From_Int.
2383 if Direct
(Right
) then
2384 return UI_From_Int
(-Direct_Val
(Right
));
2386 -- Full processing for multi-digit case. Note that we cannot just copy
2387 -- the value to the end of the table negating the first digit, since the
2388 -- range of Direct values is non-symmetrical, so we can have a negative
2389 -- value that is not Direct whose negation can be represented directly.
2393 R_Length
: constant Int
:= N_Digits
(Right
);
2394 R_Vec
: UI_Vector
(1 .. R_Length
);
2398 Init_Operand
(Right
, R_Vec
);
2399 Neg
:= R_Vec
(1) > Int_0
;
2400 R_Vec
(1) := abs R_Vec
(1);
2401 return Vector_To_Uint
(R_Vec
, Neg
);
2410 function UI_Rem
(Left
: Int
; Right
: Uint
) return Uint
is
2412 return UI_Rem
(UI_From_Int
(Left
), Right
);
2415 function UI_Rem
(Left
: Uint
; Right
: Int
) return Uint
is
2417 return UI_Rem
(Left
, UI_From_Int
(Right
));
2420 function UI_Rem
(Left
, Right
: Uint
) return Uint
is
2424 subtype Int1_12
is Integer range 1 .. 12;
2427 pragma Assert
(Right
/= Uint_0
);
2429 if Direct
(Right
) then
2430 if Direct
(Left
) then
2431 return UI_From_Int
(Direct_Val
(Left
) rem Direct_Val
(Right
));
2435 -- Special cases when Right is less than 13 and Left is larger
2436 -- larger than one digit. All of these algorithms depend on the
2437 -- base being 2 ** 15 We work with Abs (Left) and Abs(Right)
2438 -- then multiply result by Sign (Left)
2440 if (Right
<= Uint_12
) and then (Right
>= Uint_Minus_12
) then
2442 if Left
< Uint_0
then
2448 -- All cases are listed, grouped by mathematical method It is
2449 -- not inefficient to do have this case list out of order since
2450 -- GCC sorts the cases we list.
2452 case Int1_12
(abs (Direct_Val
(Right
))) is
2457 -- Powers of two are simple AND's with LS Left Digit GCC
2458 -- will recognise these constants as powers of 2 and replace
2459 -- the rem with simpler operations where possible.
2461 -- Least_Sig_Digit might return Negative numbers
2464 return UI_From_Int
(
2465 Sign
* (Least_Sig_Digit
(Left
) mod 2));
2468 return UI_From_Int
(
2469 Sign
* (Least_Sig_Digit
(Left
) mod 4));
2472 return UI_From_Int
(
2473 Sign
* (Least_Sig_Digit
(Left
) mod 8));
2475 -- Some number theoretical tricks:
2477 -- If B Rem Right = 1 then
2478 -- Left Rem Right = Sum_Of_Digits_Base_B (Left) Rem Right
2480 -- Note: 2^32 mod 3 = 1
2483 return UI_From_Int
(
2484 Sign
* (Sum_Double_Digits
(Left
, 1) rem Int
(3)));
2486 -- Note: 2^15 mod 7 = 1
2489 return UI_From_Int
(
2490 Sign
* (Sum_Digits
(Left
, 1) rem Int
(7)));
2492 -- Note: 2^32 mod 5 = -1
2494 -- Alternating sums might be negative, but rem is always
2495 -- positive hence we must use mod here.
2498 Tmp
:= Sum_Double_Digits
(Left
, -1) mod Int
(5);
2499 return UI_From_Int
(Sign
* Tmp
);
2501 -- Note: 2^15 mod 9 = -1
2503 -- Alternating sums might be negative, but rem is always
2504 -- positive hence we must use mod here.
2507 Tmp
:= Sum_Digits
(Left
, -1) mod Int
(9);
2508 return UI_From_Int
(Sign
* Tmp
);
2510 -- Note: 2^15 mod 11 = -1
2512 -- Alternating sums might be negative, but rem is always
2513 -- positive hence we must use mod here.
2516 Tmp
:= Sum_Digits
(Left
, -1) mod Int
(11);
2517 return UI_From_Int
(Sign
* Tmp
);
2519 -- Now resort to Chinese Remainder theorem to reduce 6, 10,
2520 -- 12 to previous special cases
2522 -- There is no reason we could not add more cases like these
2523 -- if it proves useful.
2525 -- Perhaps we should go up to 16, however we have no "trick"
2528 -- To find u mod m we:
2531 -- GCD(m1, m2) = 1 AND m = (m1 * m2).
2533 -- Next we pick (Basis) M1, M2 small S.T.
2534 -- (M1 mod m1) = (M2 mod m2) = 1 AND
2535 -- (M1 mod m2) = (M2 mod m1) = 0
2537 -- So u mod m = (u1 * M1 + u2 * M2) mod m Where u1 = (u mod
2538 -- m1) AND u2 = (u mod m2); Under typical circumstances the
2539 -- last mod m can be done with a (possible) single
2542 -- m1 = 2; m2 = 3; M1 = 3; M2 = 4;
2545 Tmp
:= 3 * (Least_Sig_Digit
(Left
) rem 2) +
2546 4 * (Sum_Double_Digits
(Left
, 1) rem 3);
2547 return UI_From_Int
(Sign
* (Tmp
rem 6));
2549 -- m1 = 2; m2 = 5; M1 = 5; M2 = 6;
2552 Tmp
:= 5 * (Least_Sig_Digit
(Left
) rem 2) +
2553 6 * (Sum_Double_Digits
(Left
, -1) mod 5);
2554 return UI_From_Int
(Sign
* (Tmp
rem 10));
2556 -- m1 = 3; m2 = 4; M1 = 4; M2 = 9;
2559 Tmp
:= 4 * (Sum_Double_Digits
(Left
, 1) rem 3) +
2560 9 * (Least_Sig_Digit
(Left
) rem 4);
2561 return UI_From_Int
(Sign
* (Tmp
rem 12));
2566 -- Else fall through to general case
2568 -- The special case Length (Left) = Length (Right) = 1 in Div
2569 -- looks slow. It uses UI_To_Int when Int should suffice. ???
2574 Quotient
, Remainder
: Uint
;
2577 (Left
, Right
, Quotient
, Remainder
,
2578 Discard_Quotient
=> True,
2579 Discard_Remainder
=> False);
2588 function UI_Sub
(Left
: Int
; Right
: Uint
) return Uint
is
2590 return UI_Add
(Left
, -Right
);
2593 function UI_Sub
(Left
: Uint
; Right
: Int
) return Uint
is
2595 return UI_Add
(Left
, -Right
);
2598 function UI_Sub
(Left
: Uint
; Right
: Uint
) return Uint
is
2600 if Direct
(Left
) and then Direct
(Right
) then
2601 return UI_From_Int
(Direct_Val
(Left
) - Direct_Val
(Right
));
2603 return UI_Add
(Left
, -Right
);
2611 function UI_To_CC
(Input
: Uint
) return Char_Code
is
2613 if Direct
(Input
) then
2614 return Char_Code
(Direct_Val
(Input
));
2616 -- Case of input is more than one digit
2620 In_Length
: constant Int
:= N_Digits
(Input
);
2621 In_Vec
: UI_Vector
(1 .. In_Length
);
2625 Init_Operand
(Input
, In_Vec
);
2627 -- We assume value is positive
2630 for Idx
in In_Vec
'Range loop
2631 Ret_CC
:= Ret_CC
* Char_Code
(Base
) +
2632 Char_Code
(abs In_Vec
(Idx
));
2644 function UI_To_Int
(Input
: Uint
) return Int
is
2646 if Direct
(Input
) then
2647 return Direct_Val
(Input
);
2649 -- Case of input is more than one digit
2653 In_Length
: constant Int
:= N_Digits
(Input
);
2654 In_Vec
: UI_Vector
(1 .. In_Length
);
2658 -- Uints of more than one digit could be outside the range for
2659 -- Ints. Caller should have checked for this if not certain.
2660 -- Fatal error to attempt to convert from value outside Int'Range.
2662 pragma Assert
(UI_Is_In_Int_Range
(Input
));
2664 -- Otherwise, proceed ahead, we are OK
2666 Init_Operand
(Input
, In_Vec
);
2669 -- Calculate -|Input| and then negates if value is positive. This
2670 -- handles our current definition of Int (based on 2s complement).
2671 -- Is it secure enough???
2673 for Idx
in In_Vec
'Range loop
2674 Ret_Int
:= Ret_Int
* Base
- abs In_Vec
(Idx
);
2677 if In_Vec
(1) < Int_0
then
2690 procedure UI_Write
(Input
: Uint
; Format
: UI_Format
:= Auto
) is
2692 Image_Out
(Input
, False, Format
);
2695 ---------------------
2696 -- Vector_To_Uint --
2697 ---------------------
2699 function Vector_To_Uint
2700 (In_Vec
: UI_Vector
;
2708 -- The vector can contain leading zeros. These are not stored in the
2709 -- table, so loop through the vector looking for first non-zero digit
2711 for J
in In_Vec
'Range loop
2712 if In_Vec
(J
) /= Int_0
then
2714 -- The length of the value is the length of the rest of the vector
2716 Size
:= In_Vec
'Last - J
+ 1;
2718 -- One digit value can always be represented directly
2720 if Size
= Int_1
then
2722 return Uint
(Int
(Uint_Direct_Bias
) - In_Vec
(J
));
2724 return Uint
(Int
(Uint_Direct_Bias
) + In_Vec
(J
));
2727 -- Positive two digit values may be in direct representation range
2729 elsif Size
= Int_2
and then not Negative
then
2730 Val
:= In_Vec
(J
) * Base
+ In_Vec
(J
+ 1);
2732 if Val
<= Max_Direct
then
2733 return Uint
(Int
(Uint_Direct_Bias
) + Val
);
2737 -- The value is outside the direct representation range and must
2738 -- therefore be stored in the table. Expand the table to contain
2739 -- the count and tigis. The index of the new table entry will be
2740 -- returned as the result.
2742 Uints
.Increment_Last
;
2743 Uints
.Table
(Uints
.Last
).Length
:= Size
;
2744 Uints
.Table
(Uints
.Last
).Loc
:= Udigits
.Last
+ 1;
2746 Udigits
.Increment_Last
;
2749 Udigits
.Table
(Udigits
.Last
) := -In_Vec
(J
);
2751 Udigits
.Table
(Udigits
.Last
) := +In_Vec
(J
);
2754 for K
in 2 .. Size
loop
2755 Udigits
.Increment_Last
;
2756 Udigits
.Table
(Udigits
.Last
) := In_Vec
(J
+ K
- 1);
2763 -- Dropped through loop only if vector contained all zeros