1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Output
; use Output
;
28 with GNAT
.HTable
; use GNAT
.HTable
;
32 ------------------------
33 -- Local Declarations --
34 ------------------------
36 Uint_Int_First
: Uint
:= Uint_0
;
37 -- Uint value containing Int'First value, set by Initialize. The initial
38 -- value of Uint_0 is used for an assertion check that ensures that this
39 -- value is not used before it is initialized. This value is used in the
40 -- UI_Is_In_Int_Range predicate, and it is right that this is a host value,
41 -- since the issue is host representation of integer values.
44 -- Uint value containing Int'Last value set by Initialize
46 UI_Power_2
: array (Int
range 0 .. 128) of Uint
;
47 -- This table is used to memoize exponentiations by powers of 2. The Nth
48 -- entry, if set, contains the Uint value 2**N. Initially UI_Power_2_Set
49 -- is zero and only the 0'th entry is set, the invariant being that all
50 -- entries in the range 0 .. UI_Power_2_Set are initialized.
53 -- Number of entries set in UI_Power_2;
55 UI_Power_10
: array (Int
range 0 .. 128) of Uint
;
56 -- This table is used to memoize exponentiations by powers of 10 in the
57 -- same manner as described above for UI_Power_2.
59 UI_Power_10_Set
: Nat
;
60 -- Number of entries set in UI_Power_10;
64 -- These values are used to make sure that the mark/release mechanism does
65 -- not destroy values saved in the U_Power tables or in the hash table used
66 -- by UI_From_Int. Whenever an entry is made in either of these tables,
67 -- Uints_Min and Udigits_Min are updated to protect the entry, and Release
68 -- never cuts back beyond these minimum values.
70 Int_0
: constant Int
:= 0;
71 Int_1
: constant Int
:= 1;
72 Int_2
: constant Int
:= 2;
73 -- These values are used in some cases where the use of numeric literals
74 -- would cause ambiguities (integer vs Uint).
76 type UI_Vector
is array (Pos
range <>) of Int
;
77 -- Vector containing the integer values of a Uint value
79 -- Note: An earlier version of this package used pointers of arrays of Ints
80 -- (dynamically allocated) for the Uint type. The change leads to a few
81 -- less natural idioms used throughout this code, but eliminates all uses
82 -- of the heap except for the table package itself. For example, Uint
83 -- parameters are often converted to UI_Vectors for internal manipulation.
84 -- This is done by creating the local UI_Vector using the function N_Digits
85 -- on the Uint to find the size needed for the vector, and then calling
86 -- Init_Operand to copy the values out of the table into the vector.
88 ----------------------------
89 -- UI_From_Int Hash Table --
90 ----------------------------
92 -- UI_From_Int uses a hash table to avoid duplicating entries and wasting
93 -- storage. This is particularly important for complex cases of back
96 subtype Hnum
is Nat
range 0 .. 1022;
98 function Hash_Num
(F
: Int
) return Hnum
;
101 package UI_Ints
is new Simple_HTable
(
104 No_Element
=> No_Uint
,
109 -----------------------
110 -- Local Subprograms --
111 -----------------------
113 function Direct
(U
: Valid_Uint
) return Boolean;
114 pragma Inline
(Direct
);
115 -- Returns True if U is represented directly
117 function Direct_Val
(U
: Valid_Uint
) return Int
;
118 -- U is a Uint that is represented directly. The returned result is the
119 -- value represented.
121 function GCD
(Jin
, Kin
: Int
) return Int
;
122 -- Compute GCD of two integers. Assumes that Jin >= Kin >= 0
128 -- Common processing for UI_Image and UI_Write, To_Buffer is set True for
129 -- UI_Image, and false for UI_Write, and Format is copied from the Format
130 -- parameter to UI_Image or UI_Write.
132 procedure Init_Operand
(UI
: Valid_Uint
; Vec
: out UI_Vector
);
133 pragma Inline
(Init_Operand
);
134 -- This procedure puts the value of UI into the vector in canonical
135 -- multiple precision format. The parameter should be of the correct size
136 -- as determined by a previous call to N_Digits (UI). The first digit of
137 -- Vec contains the sign, all other digits are always non-negative. Note
138 -- that the input may be directly represented, and in this case Vec will
139 -- contain the corresponding one or two digit value. The low bound of Vec
142 function Vector_To_Uint
144 Negative
: Boolean) return Valid_Uint
;
145 -- Functions that calculate values in UI_Vectors, call this function to
146 -- create and return the Uint value. In_Vec contains the multiple precision
147 -- (Base) representation of a non-negative value. Leading zeroes are
148 -- permitted. Negative is set if the desired result is the negative of the
149 -- given value. The result will be either the appropriate directly
150 -- represented value, or a table entry in the proper canonical format is
151 -- created and returned.
153 -- Note that Init_Operand puts a signed value in the result vector, but
154 -- Vector_To_Uint is always presented with a non-negative value. The
155 -- processing of signs is something that is done by the caller before
156 -- calling Vector_To_Uint.
158 function Least_Sig_Digit
(Arg
: Valid_Uint
) return Int
;
159 pragma Inline
(Least_Sig_Digit
);
160 -- Returns the Least Significant Digit of Arg quickly. When the given Uint
161 -- is less than 2**15, the value returned is the input value, in this case
162 -- the result may be negative. It is expected that any use will mask off
163 -- unnecessary bits. This is used for finding Arg mod B where B is a power
164 -- of two. Hence the actual base is irrelevant as long as it is a power of
167 procedure Most_Sig_2_Digits
171 Right_Hat
: out Int
);
172 -- Returns leading two significant digits from the given pair of Uint's.
173 -- Mathematically: returns Left / (Base**K) and Right / (Base**K) where
174 -- K is as small as possible S.T. Right_Hat < Base * Base. It is required
175 -- that Left >= Right for the algorithm to work.
177 function N_Digits
(Input
: Valid_Uint
) return Int
;
178 pragma Inline
(N_Digits
);
179 -- Returns number of "digits" in a Uint
182 (Left
, Right
: Valid_Uint
;
184 Remainder
: out Uint
;
185 Discard_Quotient
: Boolean := False;
186 Discard_Remainder
: Boolean := False);
187 -- Compute Euclidean division of Left by Right. If Discard_Quotient is
188 -- False then the quotient is returned in Quotient. If Discard_Remainder
189 -- is False, then the remainder is returned in Remainder.
191 -- If Discard_Quotient is True, Quotient is set to No_Uint.
192 -- If Discard_Remainder is True, Remainder is set to No_Uint.
194 function UI_Modular_Exponentiation
197 Modulo
: Valid_Uint
) return Valid_Uint
with Unreferenced
;
198 -- Efficiently compute (B**E) rem Modulo
200 function UI_Modular_Inverse
201 (N
: Valid_Uint
; Modulo
: Valid_Uint
) return Valid_Uint
with Unreferenced
;
202 -- Compute the multiplicative inverse of N in modular arithmetics with the
203 -- given Modulo (uses Euclid's algorithm). Note: the call is considered
204 -- to be erroneous (and the behavior is undefined) if n is not invertible.
210 function Direct
(U
: Valid_Uint
) return Boolean is
212 return Int
(U
) <= Int
(Uint_Direct_Last
);
219 function Direct_Val
(U
: Valid_Uint
) return Int
is
221 pragma Assert
(Direct
(U
));
222 return Int
(U
) - Int
(Uint_Direct_Bias
);
229 function GCD
(Jin
, Kin
: Int
) return Int
is
233 pragma Assert
(Jin
>= Kin
);
234 pragma Assert
(Kin
>= Int_0
);
238 while K
/= Uint_0
loop
251 function Hash_Num
(F
: Int
) return Hnum
is
253 return Types
."mod" (F
, Hnum
'Range_Length);
265 Marks
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
269 Digs_Output
: Natural := 0;
270 -- Counts digits output. In hex mode, but not in decimal mode, we
271 -- put an underline after every four hex digits that are output.
273 Exponent
: Natural := 0;
274 -- If the number is too long to fit in the buffer, we switch to an
275 -- approximate output format with an exponent. This variable records
276 -- the exponent value.
278 function Better_In_Hex
return Boolean;
279 -- Determines if it is better to generate digits in base 16 (result
280 -- is true) or base 10 (result is false). The choice is purely a
281 -- matter of convenience and aesthetics, so it does not matter which
282 -- value is returned from a correctness point of view.
284 procedure Image_Char
(C
: Character);
285 -- Output one character
287 procedure Image_String
(S
: String);
290 procedure Image_Exponent
(N
: Natural);
291 -- Output non-zero exponent. Note that we only use the exponent form in
292 -- the buffer case, so we know that To_Buffer is true.
294 procedure Image_Uint
(U
: Valid_Uint
);
295 -- Internal procedure to output characters of non-negative Uint
301 function Better_In_Hex
return Boolean is
302 T16
: constant Valid_Uint
:= Uint_2
**Int
'(16);
303 A : Valid_Uint := UI_Abs (Input);
306 -- Small values up to 2**16 can always be in decimal
312 -- Otherwise, see if we are a power of 2 or one less than a power
313 -- of 2. For the moment these are the only cases printed in hex.
315 if A mod Uint_2 = Uint_1 then
320 if A mod T16 /= Uint_0 then
330 while A > Uint_2 loop
331 if A mod Uint_2 /= Uint_0 then
346 procedure Image_Char (C : Character) is
349 if UI_Image_Length + 6 > UI_Image_Max then
350 Exponent := Exponent + 1;
352 UI_Image_Length := UI_Image_Length + 1;
353 UI_Image_Buffer (UI_Image_Length) := C;
364 procedure Image_Exponent (N : Natural) is
367 Image_Exponent (N / 10);
370 UI_Image_Length := UI_Image_Length + 1;
371 UI_Image_Buffer (UI_Image_Length) :=
372 Character'Val (Character'Pos ('0') + N mod 10);
379 procedure Image_String (S : String) is
390 procedure Image_Uint (U : Valid_Uint) is
391 H : constant array (Int range 0 .. 15) of Character :=
396 UI_Div_Rem (U, Base, Q, R);
402 if Digs_Output = 4 and then Base = Uint_16 then
407 Image_Char (H (UI_To_Int (R)));
409 Digs_Output := Digs_Output + 1;
412 -- Start of processing for Image_Out
416 Image_String ("No_Uint");
420 UI_Image_Length := 0;
422 if Input < Uint_0 then
430 or else (Format = Auto and then Better_In_Hex)
444 if Exponent /= 0 then
445 UI_Image_Length := UI_Image_Length + 1;
446 UI_Image_Buffer (UI_Image_Length) := 'E
';
447 Image_Exponent (Exponent);
450 Uintp.Release (Marks);
457 procedure Init_Operand (UI : Valid_Uint; Vec : out UI_Vector) is
460 pragma Assert (Vec'First = Int'(1));
464 Vec
(1) := Direct_Val
(UI
);
466 if Vec
(1) >= Base
then
467 Vec
(2) := Vec
(1) rem Base
;
468 Vec
(1) := Vec
(1) / Base
;
472 Loc
:= Uints
.Table
(UI
).Loc
;
474 for J
in 1 .. Uints
.Table
(UI
).Length
loop
475 Vec
(J
) := Udigits
.Table
(Loc
+ J
- 1);
484 procedure Initialize
is
489 Uint_Int_First
:= UI_From_Int
(Int
'First);
490 Uint_Int_Last
:= UI_From_Int
(Int
'Last);
492 UI_Power_2
(0) := Uint_1
;
495 UI_Power_10
(0) := Uint_1
;
496 UI_Power_10_Set
:= 0;
498 Uints_Min
:= Uints
.Last
;
499 Udigits_Min
:= Udigits
.Last
;
504 ---------------------
505 -- Least_Sig_Digit --
506 ---------------------
508 function Least_Sig_Digit
(Arg
: Valid_Uint
) return Int
is
513 V
:= Direct_Val
(Arg
);
519 -- Note that this result may be negative
526 (Uints
.Table
(Arg
).Loc
+ Uints
.Table
(Arg
).Length
- 1);
534 function Mark
return Save_Mark
is
536 return (Save_Uint
=> Uints
.Last
, Save_Udigit
=> Udigits
.Last
);
539 -----------------------
540 -- Most_Sig_2_Digits --
541 -----------------------
543 procedure Most_Sig_2_Digits
550 pragma Assert
(Left
>= Right
);
552 if Direct
(Left
) then
553 pragma Assert
(Direct
(Right
));
554 Left_Hat
:= Direct_Val
(Left
);
555 Right_Hat
:= Direct_Val
(Right
);
561 Udigits
.Table
(Uints
.Table
(Left
).Loc
);
563 Udigits
.Table
(Uints
.Table
(Left
).Loc
+ 1);
566 -- It is not so clear what to return when Arg is negative???
568 Left_Hat
:= abs (L1
) * Base
+ L2
;
573 Length_L
: constant Int
:= Uints
.Table
(Left
).Length
;
580 if Direct
(Right
) then
581 T
:= Direct_Val
(Right
);
582 R1
:= abs (T
/ Base
);
587 R1
:= abs (Udigits
.Table
(Uints
.Table
(Right
).Loc
));
588 R2
:= Udigits
.Table
(Uints
.Table
(Right
).Loc
+ 1);
589 Length_R
:= Uints
.Table
(Right
).Length
;
592 if Length_L
= Length_R
then
593 Right_Hat
:= R1
* Base
+ R2
;
594 elsif Length_L
= Length_R
+ Int_1
then
600 end Most_Sig_2_Digits
;
606 function N_Digits
(Input
: Valid_Uint
) return Int
is
608 if Direct
(Input
) then
609 if Direct_Val
(Input
) >= Base
then
616 return Uints
.Table
(Input
).Length
;
624 function Num_Bits
(Input
: Valid_Uint
) return Nat
is
629 -- Largest negative number has to be handled specially, since it is in
630 -- Int_Range, but we cannot take the absolute value.
632 if Input
= Uint_Int_First
then
635 -- For any other number in Int_Range, get absolute value of number
637 elsif UI_Is_In_Int_Range
(Input
) then
638 Num
:= abs (UI_To_Int
(Input
));
641 -- If not in Int_Range then initialize bit count for all low order
642 -- words, and set number to high order digit.
645 Bits
:= Base_Bits
* (Uints
.Table
(Input
).Length
- 1);
646 Num
:= abs (Udigits
.Table
(Uints
.Table
(Input
).Loc
));
649 -- Increase bit count for remaining value in Num
651 while Types
.">" (Num
, 0) loop
663 procedure pid
(Input
: Uint
) is
665 UI_Write
(Input
, Decimal
);
673 procedure pih
(Input
: Uint
) is
675 UI_Write
(Input
, Hex
);
683 procedure Release
(M
: Save_Mark
) is
685 Uints
.Set_Last
(Valid_Uint
'Max (M
.Save_Uint
, Uints_Min
));
686 Udigits
.Set_Last
(Int
'Max (M
.Save_Udigit
, Udigits_Min
));
689 ----------------------
690 -- Release_And_Save --
691 ----------------------
693 procedure Release_And_Save
(M
: Save_Mark
; UI
: in out Valid_Uint
) is
700 UE_Len
: constant Pos
:= Uints
.Table
(UI
).Length
;
701 UE_Loc
: constant Int
:= Uints
.Table
(UI
).Loc
;
703 UD
: constant Udigits
.Table_Type
(1 .. UE_Len
) :=
704 Udigits
.Table
(UE_Loc
.. UE_Loc
+ UE_Len
- 1);
709 Uints
.Append
((Length
=> UE_Len
, Loc
=> Udigits
.Last
+ 1));
712 for J
in 1 .. UE_Len
loop
713 Udigits
.Append
(UD
(J
));
717 end Release_And_Save
;
719 procedure Release_And_Save
(M
: Save_Mark
; UI1
, UI2
: in out Valid_Uint
) is
722 Release_And_Save
(M
, UI2
);
724 elsif Direct
(UI2
) then
725 Release_And_Save
(M
, UI1
);
729 UE1_Len
: constant Pos
:= Uints
.Table
(UI1
).Length
;
730 UE1_Loc
: constant Int
:= Uints
.Table
(UI1
).Loc
;
732 UD1
: constant Udigits
.Table_Type
(1 .. UE1_Len
) :=
733 Udigits
.Table
(UE1_Loc
.. UE1_Loc
+ UE1_Len
- 1);
735 UE2_Len
: constant Pos
:= Uints
.Table
(UI2
).Length
;
736 UE2_Loc
: constant Int
:= Uints
.Table
(UI2
).Loc
;
738 UD2
: constant Udigits
.Table_Type
(1 .. UE2_Len
) :=
739 Udigits
.Table
(UE2_Loc
.. UE2_Loc
+ UE2_Len
- 1);
744 Uints
.Append
((Length
=> UE1_Len
, Loc
=> Udigits
.Last
+ 1));
747 for J
in 1 .. UE1_Len
loop
748 Udigits
.Append
(UD1
(J
));
751 Uints
.Append
((Length
=> UE2_Len
, Loc
=> Udigits
.Last
+ 1));
754 for J
in 1 .. UE2_Len
loop
755 Udigits
.Append
(UD2
(J
));
759 end Release_And_Save
;
765 function UI_Abs
(Right
: Valid_Uint
) return Unat
is
767 if Right
< Uint_0
then
778 function UI_Add
(Left
: Int
; Right
: Valid_Uint
) return Valid_Uint
is
780 return UI_Add
(UI_From_Int
(Left
), Right
);
783 function UI_Add
(Left
: Valid_Uint
; Right
: Int
) return Valid_Uint
is
785 return UI_Add
(Left
, UI_From_Int
(Right
));
788 function UI_Add
(Left
: Valid_Uint
; Right
: Valid_Uint
) return Valid_Uint
is
790 pragma Assert
(Present
(Left
));
791 pragma Assert
(Present
(Right
));
792 -- Assertions are here in case we're called from C++ code, which does
793 -- not check the predicates.
795 -- Simple cases of direct operands and addition of zero
797 if Direct
(Left
) then
798 if Direct
(Right
) then
799 return UI_From_Int
(Direct_Val
(Left
) + Direct_Val
(Right
));
801 elsif Int
(Left
) = Int
(Uint_0
) then
805 elsif Direct
(Right
) and then Int
(Right
) = Int
(Uint_0
) then
809 -- Otherwise full circuit is needed
812 L_Length
: constant Int
:= N_Digits
(Left
);
813 R_Length
: constant Int
:= N_Digits
(Right
);
814 L_Vec
: UI_Vector
(1 .. L_Length
);
815 R_Vec
: UI_Vector
(1 .. R_Length
);
820 X_Bigger
: Boolean := False;
821 Y_Bigger
: Boolean := False;
822 Result_Neg
: Boolean := False;
825 Init_Operand
(Left
, L_Vec
);
826 Init_Operand
(Right
, R_Vec
);
828 -- At least one of the two operands is in multi-digit form.
829 -- Calculate the number of digits sufficient to hold result.
831 if L_Length
> R_Length
then
832 Sum_Length
:= L_Length
+ 1;
835 Sum_Length
:= R_Length
+ 1;
837 if R_Length
> L_Length
then
842 -- Make copies of the absolute values of L_Vec and R_Vec into X and Y
843 -- both with lengths equal to the maximum possibly needed. This makes
844 -- looping over the digits much simpler.
847 X
: UI_Vector
(1 .. Sum_Length
);
848 Y
: UI_Vector
(1 .. Sum_Length
);
849 Tmp_UI
: UI_Vector
(1 .. Sum_Length
);
852 for J
in 1 .. Sum_Length
- L_Length
loop
856 X
(Sum_Length
- L_Length
+ 1) := abs L_Vec
(1);
858 for J
in 2 .. L_Length
loop
859 X
(J
+ (Sum_Length
- L_Length
)) := L_Vec
(J
);
862 for J
in 1 .. Sum_Length
- R_Length
loop
866 Y
(Sum_Length
- R_Length
+ 1) := abs R_Vec
(1);
868 for J
in 2 .. R_Length
loop
869 Y
(J
+ (Sum_Length
- R_Length
)) := R_Vec
(J
);
872 if (L_Vec
(1) < Int_0
) = (R_Vec
(1) < Int_0
) then
874 -- Same sign so just add
877 for J
in reverse 1 .. Sum_Length
loop
878 Tmp_Int
:= X
(J
) + Y
(J
) + Carry
;
880 if Tmp_Int
>= Base
then
881 Tmp_Int
:= Tmp_Int
- Base
;
890 return Vector_To_Uint
(X
, L_Vec
(1) < Int_0
);
893 -- Find which one has bigger magnitude
895 if not (X_Bigger
or Y_Bigger
) then
896 for J
in L_Vec
'Range loop
897 if abs L_Vec
(J
) > abs R_Vec
(J
) then
900 elsif abs R_Vec
(J
) > abs L_Vec
(J
) then
907 -- If they have identical magnitude, just return 0, else swap
908 -- if necessary so that X had the bigger magnitude. Determine
909 -- if result is negative at this time.
913 if not (X_Bigger
or Y_Bigger
) then
917 if R_Vec
(1) < Int_0
then
926 if L_Vec
(1) < Int_0
then
931 -- Subtract Y from the bigger X
935 for J
in reverse 1 .. Sum_Length
loop
936 Tmp_Int
:= X
(J
) - Y
(J
) + Borrow
;
938 if Tmp_Int
< Int_0
then
939 Tmp_Int
:= Tmp_Int
+ Base
;
948 return Vector_To_Uint
(X
, Result_Neg
);
955 --------------------------
956 -- UI_Decimal_Digits_Hi --
957 --------------------------
959 function UI_Decimal_Digits_Hi
(U
: Valid_Uint
) return Nat
is
961 -- The maximum value of a "digit" is 32767, which is 5 decimal digits,
962 -- so an N_Digit number could take up to 5 times this number of digits.
963 -- This is certainly too high for large numbers but it is not worth
966 return 5 * N_Digits
(U
);
967 end UI_Decimal_Digits_Hi
;
969 --------------------------
970 -- UI_Decimal_Digits_Lo --
971 --------------------------
973 function UI_Decimal_Digits_Lo
(U
: Valid_Uint
) return Nat
is
975 -- The maximum value of a "digit" is 32767, which is more than four
976 -- decimal digits, but not a full five digits. The easily computed
977 -- minimum number of decimal digits is thus 1 + 4 * the number of
978 -- digits. This is certainly too low for large numbers but it is not
979 -- worth worrying about.
981 return 1 + 4 * (N_Digits
(U
) - 1);
982 end UI_Decimal_Digits_Lo
;
988 function UI_Div
(Left
: Int
; Right
: Nonzero_Uint
) return Valid_Uint
is
990 return UI_Div
(UI_From_Int
(Left
), Right
);
994 (Left
: Valid_Uint
; Right
: Nonzero_Int
) return Valid_Uint
997 return UI_Div
(Left
, UI_From_Int
(Right
));
1001 (Left
: Valid_Uint
; Right
: Nonzero_Uint
) return Valid_Uint
1003 Quotient
: Valid_Uint
;
1004 Ignored_Remainder
: Uint
;
1008 Quotient
, Ignored_Remainder
,
1009 Discard_Remainder
=> True);
1017 procedure UI_Div_Rem
1018 (Left
, Right
: Valid_Uint
;
1019 Quotient
: out Uint
;
1020 Remainder
: out Uint
;
1021 Discard_Quotient
: Boolean := False;
1022 Discard_Remainder
: Boolean := False)
1025 pragma Assert
(Right
/= Uint_0
);
1027 Quotient
:= No_Uint
;
1028 Remainder
:= No_Uint
;
1030 -- Cases where both operands are represented directly
1032 if Direct
(Left
) and then Direct
(Right
) then
1034 DV_Left
: constant Int
:= Direct_Val
(Left
);
1035 DV_Right
: constant Int
:= Direct_Val
(Right
);
1038 if not Discard_Quotient
then
1039 Quotient
:= UI_From_Int
(DV_Left
/ DV_Right
);
1042 if not Discard_Remainder
then
1043 Remainder
:= UI_From_Int
(DV_Left
rem DV_Right
);
1051 L_Length
: constant Int
:= N_Digits
(Left
);
1052 R_Length
: constant Int
:= N_Digits
(Right
);
1053 Q_Length
: constant Int
:= L_Length
- R_Length
+ 1;
1054 L_Vec
: UI_Vector
(1 .. L_Length
);
1055 R_Vec
: UI_Vector
(1 .. R_Length
);
1063 procedure UI_Div_Vector
1066 Quotient
: out UI_Vector
;
1067 Remainder
: out Int
);
1068 pragma Inline
(UI_Div_Vector
);
1069 -- Specialised variant for case where the divisor is a single digit
1071 procedure UI_Div_Vector
1074 Quotient
: out UI_Vector
;
1075 Remainder
: out Int
)
1081 for J
in L_Vec
'Range loop
1082 Tmp_Int
:= Remainder
* Base
+ abs L_Vec
(J
);
1083 Quotient
(Quotient
'First + J
- L_Vec
'First) := Tmp_Int
/ R_Int
;
1084 Remainder
:= Tmp_Int
rem R_Int
;
1087 if L_Vec
(L_Vec
'First) < Int_0
then
1088 Remainder
:= -Remainder
;
1092 -- Start of processing for UI_Div_Rem
1095 -- Result is zero if left operand is shorter than right
1097 if L_Length
< R_Length
then
1098 if not Discard_Quotient
then
1102 if not Discard_Remainder
then
1109 Init_Operand
(Left
, L_Vec
);
1110 Init_Operand
(Right
, R_Vec
);
1112 -- Case of right operand is single digit. Here we can simply divide
1113 -- each digit of the left operand by the divisor, from most to least
1114 -- significant, carrying the remainder to the next digit (just like
1115 -- ordinary long division by hand).
1117 if R_Length
= Int_1
then
1118 Tmp_Divisor
:= abs R_Vec
(1);
1121 Quotient_V
: UI_Vector
(1 .. L_Length
);
1124 UI_Div_Vector
(L_Vec
, Tmp_Divisor
, Quotient_V
, Remainder_I
);
1126 if not Discard_Quotient
then
1129 (Quotient_V
, (L_Vec
(1) < Int_0
xor R_Vec
(1) < Int_0
));
1132 if not Discard_Remainder
then
1133 Remainder
:= UI_From_Int
(Remainder_I
);
1140 -- The possible simple cases have been exhausted. Now turn to the
1141 -- algorithm D from the section of Knuth mentioned at the top of
1144 Algorithm_D
: declare
1145 Dividend
: UI_Vector
(1 .. L_Length
+ 1);
1146 Divisor
: UI_Vector
(1 .. R_Length
);
1147 Quotient_V
: UI_Vector
(1 .. Q_Length
);
1154 -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1155 -- scale d, and then multiply Left and Right (u and v in the book)
1156 -- by d to get the dividend and divisor to work with.
1158 D
:= Base
/ (abs R_Vec
(1) + 1);
1161 Dividend
(2) := abs L_Vec
(1);
1163 for J
in 3 .. L_Length
+ Int_1
loop
1164 Dividend
(J
) := L_Vec
(J
- 1);
1167 Divisor
(1) := abs R_Vec
(1);
1169 for J
in Int_2
.. R_Length
loop
1170 Divisor
(J
) := R_Vec
(J
);
1175 -- Multiply Dividend by d
1178 for J
in reverse Dividend
'Range loop
1179 Tmp_Int
:= Dividend
(J
) * D
+ Carry
;
1180 Dividend
(J
) := Tmp_Int
rem Base
;
1181 Carry
:= Tmp_Int
/ Base
;
1184 -- Multiply Divisor by d
1187 for J
in reverse Divisor
'Range loop
1188 Tmp_Int
:= Divisor
(J
) * D
+ Carry
;
1189 Divisor
(J
) := Tmp_Int
rem Base
;
1190 Carry
:= Tmp_Int
/ Base
;
1194 -- Main loop of long division algorithm
1196 Divisor_Dig1
:= Divisor
(1);
1197 Divisor_Dig2
:= Divisor
(2);
1199 for J
in Quotient_V
'Range loop
1201 -- [ CALCULATE Q (hat) ] (step D3 in the algorithm)
1203 -- Note: this version of step D3 is from the original published
1204 -- algorithm, which is known to have a bug causing overflows.
1205 -- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz
1206 -- and http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz.
1207 -- The code below is the fixed version of this step.
1209 Tmp_Int
:= Dividend
(J
) * Base
+ Dividend
(J
+ 1);
1213 Q_Guess
:= Tmp_Int
/ Divisor_Dig1
;
1214 R_Guess
:= Tmp_Int
rem Divisor_Dig1
;
1218 while Q_Guess
>= Base
1219 or else Divisor_Dig2
* Q_Guess
>
1220 R_Guess
* Base
+ Dividend
(J
+ 2)
1222 Q_Guess
:= Q_Guess
- 1;
1223 R_Guess
:= R_Guess
+ Divisor_Dig1
;
1224 exit when R_Guess
>= Base
;
1227 -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
1228 -- subtracted from the remaining dividend.
1231 for K
in reverse Divisor
'Range loop
1232 Tmp_Int
:= Dividend
(J
+ K
) - Q_Guess
* Divisor
(K
) + Carry
;
1233 Tmp_Dig
:= Tmp_Int
rem Base
;
1234 Carry
:= Tmp_Int
/ Base
;
1236 if Tmp_Dig
< Int_0
then
1237 Tmp_Dig
:= Tmp_Dig
+ Base
;
1241 Dividend
(J
+ K
) := Tmp_Dig
;
1244 Dividend
(J
) := Dividend
(J
) + Carry
;
1246 -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
1248 -- Here there is a slight difference from the book: the last
1249 -- carry is always added in above and below (cancelling each
1250 -- other). In fact the dividend going negative is used as
1253 -- If the Dividend went negative, then Q_Guess was off by
1254 -- one, so it is decremented, and the divisor is added back
1255 -- into the relevant portion of the dividend.
1257 if Dividend
(J
) < Int_0
then
1258 Q_Guess
:= Q_Guess
- 1;
1261 for K
in reverse Divisor
'Range loop
1262 Tmp_Int
:= Dividend
(J
+ K
) + Divisor
(K
) + Carry
;
1264 if Tmp_Int
>= Base
then
1265 Tmp_Int
:= Tmp_Int
- Base
;
1271 Dividend
(J
+ K
) := Tmp_Int
;
1274 Dividend
(J
) := Dividend
(J
) + Carry
;
1277 -- Finally we can get the next quotient digit
1279 Quotient_V
(J
) := Q_Guess
;
1282 -- [ UNNORMALIZE ] (step D8)
1284 if not Discard_Quotient
then
1285 Quotient
:= Vector_To_Uint
1286 (Quotient_V
, (L_Vec
(1) < Int_0
xor R_Vec
(1) < Int_0
));
1289 if not Discard_Remainder
then
1291 Remainder_V
: UI_Vector
(1 .. R_Length
);
1294 pragma Assert
(D
/= Int
'(0));
1296 (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last),
1298 Remainder_V, Ignore);
1299 Remainder := Vector_To_Uint (Remainder_V, L_Vec (1) < Int_0);
1310 function UI_Eq (Left : Int; Right : Valid_Uint) return Boolean is
1312 return not UI_Ne (UI_From_Int (Left), Right);
1315 function UI_Eq (Left : Valid_Uint; Right : Int) return Boolean is
1317 return not UI_Ne (Left, UI_From_Int (Right));
1320 function UI_Eq (Left : Valid_Uint; Right : Valid_Uint) return Boolean is
1322 return not UI_Ne (Left, Right);
1329 function UI_Expon (Left : Int; Right : Unat) return Valid_Uint is
1331 return UI_Expon (UI_From_Int (Left), Right);
1334 function UI_Expon (Left : Valid_Uint; Right : Nat) return Valid_Uint is
1336 return UI_Expon (Left, UI_From_Int (Right));
1339 function UI_Expon (Left : Int; Right : Nat) return Valid_Uint is
1341 return UI_Expon (UI_From_Int (Left), UI_From_Int (Right));
1345 (Left : Valid_Uint; Right : Unat) return Valid_Uint
1348 pragma Assert (Right >= Uint_0);
1350 -- Any value raised to power of 0 is 1
1352 if Right = Uint_0 then
1355 -- 0 to any positive power is 0
1357 elsif Left = Uint_0 then
1360 -- 1 to any power is 1
1362 elsif Left = Uint_1 then
1365 -- Any value raised to power of 1 is that value
1367 elsif Right = Uint_1 then
1370 -- Cases which can be done by table lookup
1372 elsif Right <= Uint_128 then
1374 -- 2**N for N in 2 .. 128
1376 if Left = Uint_2 then
1378 Right_Int : constant Int := Direct_Val (Right);
1381 if Right_Int > UI_Power_2_Set then
1382 for J in UI_Power_2_Set + Int_1 .. Right_Int loop
1383 UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2;
1384 Uints_Min := Uints.Last;
1385 Udigits_Min := Udigits.Last;
1388 UI_Power_2_Set := Right_Int;
1391 return UI_Power_2 (Right_Int);
1394 -- 10**N for N in 2 .. 128
1396 elsif Left = Uint_10 then
1398 Right_Int : constant Int := Direct_Val (Right);
1401 if Right_Int > UI_Power_10_Set then
1402 for J in UI_Power_10_Set + Int_1 .. Right_Int loop
1403 UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10);
1404 Uints_Min := Uints.Last;
1405 Udigits_Min := Udigits.Last;
1408 UI_Power_10_Set := Right_Int;
1411 return UI_Power_10 (Right_Int);
1416 -- If we fall through, then we have the general case (see Knuth 4.6.3)
1419 N : Valid_Uint := Right;
1420 Squares : Valid_Uint := Left;
1421 Result : Valid_Uint := Uint_1;
1422 M : constant Uintp.Save_Mark := Uintp.Mark;
1426 if (Least_Sig_Digit (N) mod Int_2) = Int_1 then
1427 Result := Result * Squares;
1431 exit when N = Uint_0;
1432 Squares := Squares * Squares;
1435 Uintp.Release_And_Save (M, Result);
1444 function UI_From_CC (Input : Char_Code) return Valid_Uint is
1446 return UI_From_Int (Int (Input));
1453 function UI_From_Int (Input : Int) return Valid_Uint is
1457 if Min_Direct <= Input and then Input <= Max_Direct then
1458 return Valid_Uint (Int (Uint_Direct_Bias) + Input);
1461 -- If already in the hash table, return entry
1463 U := UI_Ints.Get (Input);
1469 -- For values of larger magnitude, compute digits into a vector and call
1473 Max_For_Int : constant := 3;
1474 -- Base is defined so that 3 Uint digits is sufficient to hold the
1475 -- largest possible Int value.
1477 V : UI_Vector (1 .. Max_For_Int);
1479 Temp_Integer : Int := Input;
1482 for J in reverse V'Range loop
1483 V (J) := abs (Temp_Integer rem Base);
1484 Temp_Integer := Temp_Integer / Base;
1487 U := Vector_To_Uint (V, Input < Int_0);
1488 UI_Ints.Set (Input, U);
1489 Uints_Min := Uints.Last;
1490 Udigits_Min := Udigits.Last;
1495 ----------------------
1496 -- UI_From_Integral --
1497 ----------------------
1499 function UI_From_Integral (Input : In_T) return Valid_Uint is
1501 -- If in range of our normal conversion function, use it so we can use
1502 -- direct access and our cache.
1504 if In_T'Size <= Int'Size
1505 or else Input in In_T (Int'First) .. In_T (Int'Last)
1507 return UI_From_Int (Int (Input));
1510 -- For values of larger magnitude, compute digits into a vector and
1511 -- call Vector_To_Uint.
1514 Max_For_In_T : constant Int := 3 * In_T'Size / Int'Size;
1515 Our_Base : constant In_T := In_T (Base);
1516 Temp_Integer : In_T := Input;
1517 -- Base is defined so that 3 Uint digits is sufficient to hold the
1518 -- largest possible Int value.
1521 V : UI_Vector (1 .. Max_For_In_T);
1524 for J in reverse V'Range loop
1525 V (J) := Int (abs (Temp_Integer rem Our_Base));
1526 Temp_Integer := Temp_Integer / Our_Base;
1529 U := Vector_To_Uint (V, Input < 0);
1530 Uints_Min := Uints.Last;
1531 Udigits_Min := Udigits.Last;
1536 end UI_From_Integral;
1542 -- Lehmer's algorithm for GCD
1544 -- The idea is to avoid using multiple precision arithmetic wherever
1545 -- possible, substituting Int arithmetic instead. See Knuth volume II,
1546 -- Algorithm L (page 329).
1548 -- We use the same notation as Knuth (U_Hat standing for the obvious)
1550 function UI_GCD (Uin, Vin : Valid_Uint) return Valid_Uint is
1552 -- Copies of Uin and Vin
1555 -- The most Significant digits of U,V
1557 A, B, C, D, T, Q, Den1, Den2 : Int;
1559 Tmp_UI : Valid_Uint;
1560 Marks : constant Uintp.Save_Mark := Uintp.Mark;
1561 Iterations : Integer := 0;
1564 pragma Assert (Uin >= Vin);
1565 pragma Assert (Vin >= Uint_0);
1571 Iterations := Iterations + 1;
1578 UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V)));
1582 Most_Sig_2_Digits (U, V, U_Hat, V_Hat);
1589 -- We might overflow and get division by zero here. This just
1590 -- means we cannot take the single precision step
1594 exit when Den1 = Int_0 or else Den2 = Int_0;
1596 -- Compute Q, the trial quotient
1598 Q := (U_Hat + A) / Den1;
1600 exit when Q /= ((U_Hat + B) / Den2);
1602 -- A single precision step Euclid step will give same answer as a
1603 -- multiprecision one.
1613 T := U_Hat - (Q * V_Hat);
1619 -- Take a multiprecision Euclid step
1623 -- No single precision steps take a regular Euclid step
1630 -- Use prior single precision steps to compute this Euclid step
1632 Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V);
1633 V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V);
1637 -- If the operands are very different in magnitude, the loop will
1638 -- generate large amounts of short-lived data, which it is worth
1639 -- removing periodically.
1641 if Iterations > 100 then
1642 Release_And_Save (Marks, U, V);
1652 function UI_Ge (Left : Int; Right : Valid_Uint) return Boolean is
1654 return not UI_Lt (UI_From_Int (Left), Right);
1657 function UI_Ge (Left : Valid_Uint; Right : Int) return Boolean is
1659 return not UI_Lt (Left, UI_From_Int (Right));
1662 function UI_Ge (Left : Valid_Uint; Right : Valid_Uint) return Boolean is
1664 return not UI_Lt (Left, Right);
1671 function UI_Gt (Left : Int; Right : Valid_Uint) return Boolean is
1673 return UI_Lt (Right, UI_From_Int (Left));
1676 function UI_Gt (Left : Valid_Uint; Right : Int) return Boolean is
1678 return UI_Lt (UI_From_Int (Right), Left);
1681 function UI_Gt (Left : Valid_Uint; Right : Valid_Uint) return Boolean is
1683 return UI_Lt (Left => Right, Right => Left);
1690 procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
1692 Image_Out (Input, True, Format);
1697 Format : UI_Format := Auto) return String
1700 Image_Out (Input, True, Format);
1701 return UI_Image_Buffer (1 .. UI_Image_Length);
1704 -------------------------
1705 -- UI_Is_In_Int_Range --
1706 -------------------------
1708 function UI_Is_In_Int_Range (Input : Valid_Uint) return Boolean is
1709 pragma Assert (Present (Input));
1710 -- Assertion is here in case we're called from C++ code, which does
1711 -- not check the predicates.
1713 -- Make sure we don't get called before Initialize
1715 pragma Assert (Uint_Int_First /= Uint_0);
1717 if Direct (Input) then
1720 return Input >= Uint_Int_First and then Input <= Uint_Int_Last;
1722 end UI_Is_In_Int_Range;
1728 function UI_Le (Left : Int; Right : Valid_Uint) return Boolean is
1730 return not UI_Lt (Right, UI_From_Int (Left));
1733 function UI_Le (Left : Valid_Uint; Right : Int) return Boolean is
1735 return not UI_Lt (UI_From_Int (Right), Left);
1738 function UI_Le (Left : Valid_Uint; Right : Valid_Uint) return Boolean is
1740 return not UI_Lt (Left => Right, Right => Left);
1747 function UI_Lt (Left : Int; Right : Valid_Uint) return Boolean is
1749 return UI_Lt (UI_From_Int (Left), Right);
1752 function UI_Lt (Left : Valid_Uint; Right : Int) return Boolean is
1754 return UI_Lt (Left, UI_From_Int (Right));
1757 function UI_Lt (Left : Valid_Uint; Right : Valid_Uint) return Boolean is
1759 pragma Assert (Present (Left));
1760 pragma Assert (Present (Right));
1761 -- Assertions are here in case we're called from C++ code, which does
1762 -- not check the predicates.
1764 -- Quick processing for identical arguments
1766 if Int (Left) = Int (Right) then
1769 -- Quick processing for both arguments directly represented
1771 elsif Direct (Left) and then Direct (Right) then
1772 return Int (Left) < Int (Right);
1774 -- At least one argument is more than one digit long
1778 L_Length : constant Int := N_Digits (Left);
1779 R_Length : constant Int := N_Digits (Right);
1781 L_Vec : UI_Vector (1 .. L_Length);
1782 R_Vec : UI_Vector (1 .. R_Length);
1785 Init_Operand (Left, L_Vec);
1786 Init_Operand (Right, R_Vec);
1788 if L_Vec (1) < Int_0 then
1790 -- First argument negative, second argument non-negative
1792 if R_Vec (1) >= Int_0 then
1795 -- Both arguments negative
1798 if L_Length /= R_Length then
1799 return L_Length > R_Length;
1801 elsif L_Vec (1) /= R_Vec (1) then
1802 return L_Vec (1) < R_Vec (1);
1805 for J in 2 .. L_Vec'Last loop
1806 if L_Vec (J) /= R_Vec (J) then
1807 return L_Vec (J) > R_Vec (J);
1816 -- First argument non-negative, second argument negative
1818 if R_Vec (1) < Int_0 then
1821 -- Both arguments non-negative
1824 if L_Length /= R_Length then
1825 return L_Length < R_Length;
1827 for J in L_Vec'Range loop
1828 if L_Vec (J) /= R_Vec (J) then
1829 return L_Vec (J) < R_Vec (J);
1845 function UI_Max (Left : Int; Right : Valid_Uint) return Valid_Uint is
1847 return UI_Max (UI_From_Int (Left), Right);
1850 function UI_Max (Left : Valid_Uint; Right : Int) return Valid_Uint is
1852 return UI_Max (Left, UI_From_Int (Right));
1855 function UI_Max (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is
1857 if Left >= Right then
1868 function UI_Min (Left : Int; Right : Valid_Uint) return Valid_Uint is
1870 return UI_Min (UI_From_Int (Left), Right);
1873 function UI_Min (Left : Valid_Uint; Right : Int) return Valid_Uint is
1875 return UI_Min (Left, UI_From_Int (Right));
1878 function UI_Min (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is
1880 if Left <= Right then
1891 function UI_Mod (Left : Int; Right : Nonzero_Uint) return Valid_Uint is
1893 return UI_Mod (UI_From_Int (Left), Right);
1897 (Left : Valid_Uint; Right : Nonzero_Int) return Valid_Uint
1900 return UI_Mod (Left, UI_From_Int (Right));
1904 (Left : Valid_Uint; Right : Nonzero_Uint) return Valid_Uint
1906 Urem : constant Valid_Uint := Left rem Right;
1909 if (Left < Uint_0) = (Right < Uint_0)
1910 or else Urem = Uint_0
1914 return Right + Urem;
1918 -------------------------------
1919 -- UI_Modular_Exponentiation --
1920 -------------------------------
1922 function UI_Modular_Exponentiation
1925 Modulo : Valid_Uint) return Valid_Uint
1927 M : constant Save_Mark := Mark;
1929 Result : Valid_Uint := Uint_1;
1930 Base : Valid_Uint := B;
1931 Exponent : Valid_Uint := E;
1934 while Exponent /= Uint_0 loop
1935 if Least_Sig_Digit (Exponent) rem Int'(2) = Int
'(1) then
1936 Result := (Result * Base) rem Modulo;
1939 Exponent := Exponent / Uint_2;
1940 Base := (Base * Base) rem Modulo;
1943 Release_And_Save (M, Result);
1945 end UI_Modular_Exponentiation;
1947 ------------------------
1948 -- UI_Modular_Inverse --
1949 ------------------------
1951 function UI_Modular_Inverse
1952 (N : Valid_Uint; Modulo : Valid_Uint) return Valid_Uint
1954 M : constant Save_Mark := Mark;
1972 UI_Div_Rem (U, V, Quotient => Q, Remainder => R);
1982 exit when R = Uint_1;
1985 if S = Int'(-1) then
1989 Release_And_Save
(M
, X
);
1991 end UI_Modular_Inverse
;
1997 function UI_Mul
(Left
: Int
; Right
: Valid_Uint
) return Valid_Uint
is
1999 return UI_Mul
(UI_From_Int
(Left
), Right
);
2002 function UI_Mul
(Left
: Valid_Uint
; Right
: Int
) return Valid_Uint
is
2004 return UI_Mul
(Left
, UI_From_Int
(Right
));
2007 function UI_Mul
(Left
: Valid_Uint
; Right
: Valid_Uint
) return Valid_Uint
is
2009 -- Case where product fits in the range of a 32-bit integer
2011 if Int
(Left
) <= Int
(Uint_Max_Simple_Mul
)
2013 Int
(Right
) <= Int
(Uint_Max_Simple_Mul
)
2015 return UI_From_Int
(Direct_Val
(Left
) * Direct_Val
(Right
));
2018 -- Otherwise we have the general case (Algorithm M in Knuth)
2021 L_Length
: constant Int
:= N_Digits
(Left
);
2022 R_Length
: constant Int
:= N_Digits
(Right
);
2023 L_Vec
: UI_Vector
(1 .. L_Length
);
2024 R_Vec
: UI_Vector
(1 .. R_Length
);
2028 Init_Operand
(Left
, L_Vec
);
2029 Init_Operand
(Right
, R_Vec
);
2030 Neg
:= L_Vec
(1) < Int_0
xor R_Vec
(1) < Int_0
;
2031 L_Vec
(1) := abs (L_Vec
(1));
2032 R_Vec
(1) := abs (R_Vec
(1));
2034 Algorithm_M
: declare
2035 Product
: UI_Vector
(1 .. L_Length
+ R_Length
);
2040 for J
in Product
'Range loop
2044 for J
in reverse R_Vec
'Range loop
2046 for K
in reverse L_Vec
'Range loop
2048 L_Vec
(K
) * R_Vec
(J
) + Product
(J
+ K
) + Carry
;
2049 Product
(J
+ K
) := Tmp_Sum
rem Base
;
2050 Carry
:= Tmp_Sum
/ Base
;
2053 Product
(J
) := Carry
;
2056 return Vector_To_Uint
(Product
, Neg
);
2065 function UI_Ne
(Left
: Int
; Right
: Valid_Uint
) return Boolean is
2067 return UI_Ne
(UI_From_Int
(Left
), Right
);
2070 function UI_Ne
(Left
: Valid_Uint
; Right
: Int
) return Boolean is
2072 return UI_Ne
(Left
, UI_From_Int
(Right
));
2075 function UI_Ne
(Left
: Valid_Uint
; Right
: Valid_Uint
) return Boolean is
2077 pragma Assert
(Present
(Left
));
2078 pragma Assert
(Present
(Right
));
2079 -- Assertions are here in case we're called from C++ code, which does
2080 -- not check the predicates.
2082 -- Quick processing for identical arguments
2084 if Int
(Left
) = Int
(Right
) then
2088 -- See if left operand directly represented
2090 if Direct
(Left
) then
2092 -- If right operand directly represented then compare
2094 if Direct
(Right
) then
2095 return Int
(Left
) /= Int
(Right
);
2097 -- Left operand directly represented, right not, must be unequal
2103 -- Right operand directly represented, left not, must be unequal
2105 elsif Direct
(Right
) then
2109 -- Otherwise both multi-word, do comparison
2112 Size
: constant Int
:= N_Digits
(Left
);
2117 if Size
/= N_Digits
(Right
) then
2121 Left_Loc
:= Uints
.Table
(Left
).Loc
;
2122 Right_Loc
:= Uints
.Table
(Right
).Loc
;
2124 for J
in Int_0
.. Size
- Int_1
loop
2125 if Udigits
.Table
(Left_Loc
+ J
) /=
2126 Udigits
.Table
(Right_Loc
+ J
)
2140 function UI_Negate
(Right
: Valid_Uint
) return Valid_Uint
is
2142 -- Case where input is directly represented. Note that since the range
2143 -- of Direct values is non-symmetrical, the result may not be directly
2144 -- represented, this is taken care of in UI_From_Int.
2146 if Direct
(Right
) then
2147 return UI_From_Int
(-Direct_Val
(Right
));
2149 -- Full processing for multi-digit case. Note that we cannot just copy
2150 -- the value to the end of the table negating the first digit, since the
2151 -- range of Direct values is non-symmetrical, so we can have a negative
2152 -- value that is not Direct whose negation can be represented directly.
2156 R_Length
: constant Int
:= N_Digits
(Right
);
2157 R_Vec
: UI_Vector
(1 .. R_Length
);
2161 Init_Operand
(Right
, R_Vec
);
2162 Neg
:= R_Vec
(1) > Int_0
;
2163 R_Vec
(1) := abs R_Vec
(1);
2164 return Vector_To_Uint
(R_Vec
, Neg
);
2173 function UI_Rem
(Left
: Int
; Right
: Nonzero_Uint
) return Valid_Uint
is
2175 return UI_Rem
(UI_From_Int
(Left
), Right
);
2179 (Left
: Valid_Uint
; Right
: Nonzero_Int
) return Valid_Uint
2182 return UI_Rem
(Left
, UI_From_Int
(Right
));
2186 (Left
: Valid_Uint
; Right
: Nonzero_Uint
) return Valid_Uint
2188 Remainder
: Valid_Uint
;
2189 Ignored_Quotient
: Uint
;
2192 pragma Assert
(Right
/= Uint_0
);
2194 if Direct
(Right
) and then Direct
(Left
) then
2195 return UI_From_Int
(Direct_Val
(Left
) rem Direct_Val
(Right
));
2199 (Left
, Right
, Ignored_Quotient
, Remainder
,
2200 Discard_Quotient
=> True);
2209 function UI_Sub
(Left
: Int
; Right
: Valid_Uint
) return Valid_Uint
is
2211 return UI_Add
(Left
, -Right
);
2214 function UI_Sub
(Left
: Valid_Uint
; Right
: Int
) return Valid_Uint
is
2216 return UI_Add
(Left
, -Right
);
2219 function UI_Sub
(Left
: Valid_Uint
; Right
: Valid_Uint
) return Valid_Uint
is
2221 if Direct
(Left
) and then Direct
(Right
) then
2222 return UI_From_Int
(Direct_Val
(Left
) - Direct_Val
(Right
));
2224 return UI_Add
(Left
, -Right
);
2232 function UI_To_CC
(Input
: Valid_Uint
) return Char_Code
is
2234 -- Char_Code and Int have equal upper bounds, so simply guard against
2235 -- negative Input and reuse conversion to Int. We trust that conversion
2236 -- to Int will raise Constraint_Error when Input is too large.
2239 (Char_Code
'First = 0 and then Int
(Char_Code
'Last) = Int
'Last);
2241 if Input
>= Uint_0
then
2242 return Char_Code
(UI_To_Int
(Input
));
2244 raise Constraint_Error
;
2252 function UI_To_Int
(Input
: Valid_Uint
) return Int
is
2254 if Direct
(Input
) then
2255 return Direct_Val
(Input
);
2257 -- Case of input is more than one digit
2261 In_Length
: constant Int
:= N_Digits
(Input
);
2262 In_Vec
: UI_Vector
(1 .. In_Length
);
2266 -- Uints of more than one digit could be outside the range for
2267 -- Ints. Caller should have checked for this if not certain.
2268 -- Constraint_Error to attempt to convert from value outside
2271 if not UI_Is_In_Int_Range
(Input
) then
2272 raise Constraint_Error
;
2275 -- Otherwise, proceed ahead, we are OK
2277 Init_Operand
(Input
, In_Vec
);
2280 -- Calculate -|Input| and then negates if value is positive. This
2281 -- handles our current definition of Int (based on 2s complement).
2282 -- Is it secure enough???
2284 for Idx
in In_Vec
'Range loop
2285 Ret_Int
:= Ret_Int
* Base
- abs In_Vec
(Idx
);
2288 if In_Vec
(1) < Int_0
then
2301 function UI_To_Unsigned_64
(Input
: Valid_Uint
) return Unsigned_64
is
2303 if Input
< Uint_0
then
2304 raise Constraint_Error
;
2307 if Direct
(Input
) then
2308 return Unsigned_64
(Direct_Val
(Input
));
2310 -- Case of input is more than one digit
2313 if Input
>= Uint_2
**Int
'(64) then
2314 raise Constraint_Error;
2318 In_Length : constant Int := N_Digits (Input);
2319 In_Vec : UI_Vector (1 .. In_Length);
2320 Ret_Int : Unsigned_64 := 0;
2323 Init_Operand (Input, In_Vec);
2325 for Idx in In_Vec'Range loop
2327 Ret_Int * Unsigned_64 (Base) + Unsigned_64 (In_Vec (Idx));
2333 end UI_To_Unsigned_64;
2339 procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is
2341 Image_Out (Input, False, Format);
2344 ---------------------
2345 -- Vector_To_Uint --
2346 ---------------------
2348 function Vector_To_Uint
2349 (In_Vec : UI_Vector;
2350 Negative : Boolean) return Valid_Uint
2356 -- The vector can contain leading zeros. These are not stored in the
2357 -- table, so loop through the vector looking for first non-zero digit
2359 for J in In_Vec'Range loop
2360 if In_Vec (J) /= Int_0 then
2362 -- The length of the value is the length of the rest of the vector
2364 Size := In_Vec'Last - J + 1;
2366 -- One digit value can always be represented directly
2368 if Size = Int_1 then
2370 return Valid_Uint (Int (Uint_Direct_Bias) - In_Vec (J));
2372 return Valid_Uint (Int (Uint_Direct_Bias) + In_Vec (J));
2375 -- Positive two digit values may be in direct representation range
2377 elsif Size = Int_2 and then not Negative then
2378 Val := In_Vec (J) * Base + In_Vec (J + 1);
2380 if Val <= Max_Direct then
2381 return Valid_Uint (Int (Uint_Direct_Bias) + Val);
2385 -- The value is outside the direct representation range and must
2386 -- therefore be stored in the table. Expand the table to contain
2387 -- the count and digits. The index of the new table entry will be
2388 -- returned as the result.
2390 Uints.Append ((Length => Size, Loc => Udigits.Last + 1));
2398 Udigits.Append (Val);
2400 for K in 2 .. Size loop
2401 Udigits.Append (In_Vec (J + K - 1));
2408 -- Dropped through loop only if vector contained all zeros