1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2020, 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Output; use Output;
33 with Tree_IO; use Tree_IO;
35 with GNAT.HTable; use GNAT.HTable;
39 ------------------------
40 -- Local Declarations --
41 ------------------------
43 Uint_Int_First : Uint := Uint_0;
44 -- Uint value containing Int'First value, set by Initialize. The initial
45 -- value of Uint_0 is used for an assertion check that ensures that this
46 -- value is not used before it is initialized. This value is used in the
47 -- UI_Is_In_Int_Range predicate, and it is right that this is a host value,
48 -- since the issue is host representation of integer values.
51 -- Uint value containing Int'Last value set by Initialize
53 UI_Power_2 : array (Int range 0 .. 64) of Uint;
54 -- This table is used to memoize exponentiations by powers of 2. The Nth
55 -- entry, if set, contains the Uint value 2**N. Initially UI_Power_2_Set
56 -- is zero and only the 0'th entry is set, the invariant being that all
57 -- entries in the range 0 .. UI_Power_2_Set are initialized.
60 -- Number of entries set in UI_Power_2;
62 UI_Power_10 : array (Int range 0 .. 64) of Uint;
63 -- This table is used to memoize exponentiations by powers of 10 in the
64 -- same manner as described above for UI_Power_2.
66 UI_Power_10_Set : Nat;
67 -- Number of entries set in UI_Power_10;
71 -- These values are used to make sure that the mark/release mechanism does
72 -- not destroy values saved in the U_Power tables or in the hash table used
73 -- by UI_From_Int. Whenever an entry is made in either of these tables,
74 -- Uints_Min and Udigits_Min are updated to protect the entry, and Release
75 -- never cuts back beyond these minimum values.
77 Int_0 : constant Int := 0;
78 Int_1 : constant Int := 1;
79 Int_2 : constant Int := 2;
80 -- These values are used in some cases where the use of numeric literals
81 -- would cause ambiguities (integer vs Uint).
83 ----------------------------
84 -- UI_From_Int Hash Table --
85 ----------------------------
87 -- UI_From_Int uses a hash table to avoid duplicating entries and wasting
88 -- storage. This is particularly important for complex cases of back
91 subtype Hnum is Nat range 0 .. 1022;
93 function Hash_Num (F : Int) return Hnum;
96 package UI_Ints is new Simple_HTable (
99 No_Element => No_Uint,
104 -----------------------
105 -- Local Subprograms --
106 -----------------------
108 function Direct (U : Uint) return Boolean;
109 pragma Inline (Direct);
110 -- Returns True if U is represented directly
112 function Direct_Val (U : Uint) return Int;
113 -- U is a Uint for is represented directly. The returned result is the
114 -- value represented.
116 function GCD (Jin, Kin : Int) return Int;
117 -- Compute GCD of two integers. Assumes that Jin >= Kin >= 0
123 -- Common processing for UI_Image and UI_Write, To_Buffer is set True for
124 -- UI_Image, and false for UI_Write, and Format is copied from the Format
125 -- parameter to UI_Image or UI_Write.
127 procedure Init_Operand (UI : Uint; Vec : out UI_Vector);
128 pragma Inline (Init_Operand);
129 -- This procedure puts the value of UI into the vector in canonical
130 -- multiple precision format. The parameter should be of the correct size
131 -- as determined by a previous call to N_Digits (UI). The first digit of
132 -- Vec contains the sign, all other digits are always non-negative. Note
133 -- that the input may be directly represented, and in this case Vec will
134 -- contain the corresponding one or two digit value. The low bound of Vec
137 function Least_Sig_Digit (Arg : Uint) return Int;
138 pragma Inline (Least_Sig_Digit);
139 -- Returns the Least Significant Digit of Arg quickly. When the given Uint
140 -- is less than 2**15, the value returned is the input value, in this case
141 -- the result may be negative. It is expected that any use will mask off
142 -- unnecessary bits. This is used for finding Arg mod B where B is a power
143 -- of two. Hence the actual base is irrelevant as long as it is a power of
146 procedure Most_Sig_2_Digits
150 Right_Hat : out Int);
151 -- Returns leading two significant digits from the given pair of Uint's.
152 -- Mathematically: returns Left / (Base**K) and Right / (Base**K) where
153 -- K is as small as possible S.T. Right_Hat < Base * Base. It is required
154 -- that Left >= Right for the algorithm to work.
156 function N_Digits (Input : Uint) return Int;
157 pragma Inline (N_Digits);
158 -- Returns number of "digits" in a Uint
163 Remainder : out Uint;
164 Discard_Quotient : Boolean := False;
165 Discard_Remainder : Boolean := False);
166 -- Compute Euclidean division of Left by Right. If Discard_Quotient is
167 -- False then the quotient is returned in Quotient (otherwise Quotient is
168 -- set to No_Uint). If Discard_Remainder is False, then the remainder is
169 -- returned in Remainder (otherwise Remainder is set to No_Uint).
171 -- If Discard_Quotient is True, Quotient is set to No_Uint
172 -- If Discard_Remainder is True, Remainder is set to No_Uint
178 function Direct (U : Uint) return Boolean is
180 return Int (U) <= Int (Uint_Direct_Last);
187 function Direct_Val (U : Uint) return Int is
189 pragma Assert (Direct (U));
190 return Int (U) - Int (Uint_Direct_Bias);
197 function GCD (Jin, Kin : Int) return Int is
201 pragma Assert (Jin >= Kin);
202 pragma Assert (Kin >= Int_0);
206 while K /= Uint_0 loop
219 function Hash_Num (F : Int) return Hnum is
221 return Types."mod" (F, Hnum'Range_Length);
233 Marks : constant Uintp.Save_Mark := Uintp.Mark;
237 Digs_Output : Natural := 0;
238 -- Counts digits output. In hex mode, but not in decimal mode, we
239 -- put an underline after every four hex digits that are output.
241 Exponent : Natural := 0;
242 -- If the number is too long to fit in the buffer, we switch to an
243 -- approximate output format with an exponent. This variable records
244 -- the exponent value.
246 function Better_In_Hex return Boolean;
247 -- Determines if it is better to generate digits in base 16 (result
248 -- is true) or base 10 (result is false). The choice is purely a
249 -- matter of convenience and aesthetics, so it does not matter which
250 -- value is returned from a correctness point of view.
252 procedure Image_Char (C : Character);
253 -- Internal procedure to output one character
255 procedure Image_Exponent (N : Natural);
256 -- Output non-zero exponent. Note that we only use the exponent form in
257 -- the buffer case, so we know that To_Buffer is true.
259 procedure Image_Uint (U : Uint);
260 -- Internal procedure to output characters of non-negative Uint
266 function Better_In_Hex return Boolean is
267 T16 : constant Uint := Uint_2**Int'(16);
273 -- Small values up to 2**16 can always be in decimal
279 -- Otherwise, see if we are a power of 2 or one less than a power
280 -- of 2. For the moment these are the only cases printed in hex.
282 if A mod Uint_2 = Uint_1 then
287 if A mod T16 /= Uint_0 then
297 while A > Uint_2 loop
298 if A mod Uint_2 /= Uint_0 then
313 procedure Image_Char (C : Character) is
316 if UI_Image_Length + 6 > UI_Image_Max then
317 Exponent := Exponent + 1;
319 UI_Image_Length := UI_Image_Length + 1;
320 UI_Image_Buffer (UI_Image_Length) := C;
331 procedure Image_Exponent (N : Natural) is
334 Image_Exponent (N / 10);
337 UI_Image_Length := UI_Image_Length + 1;
338 UI_Image_Buffer (UI_Image_Length) :=
339 Character'Val (Character'Pos ('0') + N mod 10);
346 procedure Image_Uint (U : Uint) is
347 H : constant array (Int range 0 .. 15) of Character :=
352 UI_Div_Rem (U, Base, Q, R);
358 if Digs_Output = 4 and then Base = Uint_16 then
363 Image_Char (H (UI_To_Int (R)));
365 Digs_Output := Digs_Output + 1;
368 -- Start of processing for Image_Out
371 if Input = No_Uint then
376 UI_Image_Length := 0;
378 if Input < Uint_0 then
386 or else (Format = Auto and then Better_In_Hex)
400 if Exponent /= 0 then
401 UI_Image_Length := UI_Image_Length + 1;
402 UI_Image_Buffer (UI_Image_Length) := 'E';
403 Image_Exponent (Exponent);
406 Uintp.Release (Marks);
413 procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
416 pragma Assert (Vec'First = Int'(1));
420 Vec (1) := Direct_Val (UI);
422 if Vec (1) >= Base then
423 Vec (2) := Vec (1) rem Base;
424 Vec (1) := Vec (1) / Base;
428 Loc := Uints.Table (UI).Loc;
430 for J in 1 .. Uints.Table (UI).Length loop
431 Vec (J) := Udigits.Table (Loc + J - 1);
440 procedure Initialize is
445 Uint_Int_First := UI_From_Int (Int'First);
446 Uint_Int_Last := UI_From_Int (Int'Last);
448 UI_Power_2 (0) := Uint_1;
451 UI_Power_10 (0) := Uint_1;
452 UI_Power_10_Set := 0;
454 Uints_Min := Uints.Last;
455 Udigits_Min := Udigits.Last;
460 ---------------------
461 -- Least_Sig_Digit --
462 ---------------------
464 function Least_Sig_Digit (Arg : Uint) return Int is
469 V := Direct_Val (Arg);
475 -- Note that this result may be negative
482 (Uints.Table (Arg).Loc + Uints.Table (Arg).Length - 1);
490 function Mark return Save_Mark is
492 return (Save_Uint => Uints.Last, Save_Udigit => Udigits.Last);
495 -----------------------
496 -- Most_Sig_2_Digits --
497 -----------------------
499 procedure Most_Sig_2_Digits
506 pragma Assert (Left >= Right);
508 if Direct (Left) then
509 pragma Assert (Direct (Right));
510 Left_Hat := Direct_Val (Left);
511 Right_Hat := Direct_Val (Right);
517 Udigits.Table (Uints.Table (Left).Loc);
519 Udigits.Table (Uints.Table (Left).Loc + 1);
522 -- It is not so clear what to return when Arg is negative???
524 Left_Hat := abs (L1) * Base + L2;
529 Length_L : constant Int := Uints.Table (Left).Length;
536 if Direct (Right) then
537 T := Direct_Val (Right);
538 R1 := abs (T / Base);
543 R1 := abs (Udigits.Table (Uints.Table (Right).Loc));
544 R2 := Udigits.Table (Uints.Table (Right).Loc + 1);
545 Length_R := Uints.Table (Right).Length;
548 if Length_L = Length_R then
549 Right_Hat := R1 * Base + R2;
550 elsif Length_L = Length_R + Int_1 then
556 end Most_Sig_2_Digits;
562 -- Note: N_Digits returns 1 for No_Uint
564 function N_Digits (Input : Uint) return Int is
566 if Direct (Input) then
567 if Direct_Val (Input) >= Base then
574 return Uints.Table (Input).Length;
582 function Num_Bits (Input : Uint) return Nat is
587 -- Largest negative number has to be handled specially, since it is in
588 -- Int_Range, but we cannot take the absolute value.
590 if Input = Uint_Int_First then
593 -- For any other number in Int_Range, get absolute value of number
595 elsif UI_Is_In_Int_Range (Input) then
596 Num := abs (UI_To_Int (Input));
599 -- If not in Int_Range then initialize bit count for all low order
600 -- words, and set number to high order digit.
603 Bits := Base_Bits * (Uints.Table (Input).Length - 1);
604 Num := abs (Udigits.Table (Uints.Table (Input).Loc));
607 -- Increase bit count for remaining value in Num
609 while Types.">" (Num, 0) loop
621 procedure pid (Input : Uint) is
623 UI_Write (Input, Decimal);
631 procedure pih (Input : Uint) is
633 UI_Write (Input, Hex);
641 procedure Release (M : Save_Mark) is
643 Uints.Set_Last (Uint'Max (M.Save_Uint, Uints_Min));
644 Udigits.Set_Last (Int'Max (M.Save_Udigit, Udigits_Min));
647 ----------------------
648 -- Release_And_Save --
649 ----------------------
651 procedure Release_And_Save (M : Save_Mark; UI : in out Uint) is
658 UE_Len : constant Pos := Uints.Table (UI).Length;
659 UE_Loc : constant Int := Uints.Table (UI).Loc;
661 UD : constant Udigits.Table_Type (1 .. UE_Len) :=
662 Udigits.Table (UE_Loc .. UE_Loc + UE_Len - 1);
667 Uints.Append ((Length => UE_Len, Loc => Udigits.Last + 1));
670 for J in 1 .. UE_Len loop
671 Udigits.Append (UD (J));
675 end Release_And_Save;
677 procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint) is
680 Release_And_Save (M, UI2);
682 elsif Direct (UI2) then
683 Release_And_Save (M, UI1);
687 UE1_Len : constant Pos := Uints.Table (UI1).Length;
688 UE1_Loc : constant Int := Uints.Table (UI1).Loc;
690 UD1 : constant Udigits.Table_Type (1 .. UE1_Len) :=
691 Udigits.Table (UE1_Loc .. UE1_Loc + UE1_Len - 1);
693 UE2_Len : constant Pos := Uints.Table (UI2).Length;
694 UE2_Loc : constant Int := Uints.Table (UI2).Loc;
696 UD2 : constant Udigits.Table_Type (1 .. UE2_Len) :=
697 Udigits.Table (UE2_Loc .. UE2_Loc + UE2_Len - 1);
702 Uints.Append ((Length => UE1_Len, Loc => Udigits.Last + 1));
705 for J in 1 .. UE1_Len loop
706 Udigits.Append (UD1 (J));
709 Uints.Append ((Length => UE2_Len, Loc => Udigits.Last + 1));
712 for J in 1 .. UE2_Len loop
713 Udigits.Append (UD2 (J));
717 end Release_And_Save;
723 procedure Tree_Read is
728 Tree_Read_Int (Int (Uint_Int_First));
729 Tree_Read_Int (Int (Uint_Int_Last));
730 Tree_Read_Int (UI_Power_2_Set);
731 Tree_Read_Int (UI_Power_10_Set);
732 Tree_Read_Int (Int (Uints_Min));
733 Tree_Read_Int (Udigits_Min);
735 for J in 0 .. UI_Power_2_Set loop
736 Tree_Read_Int (Int (UI_Power_2 (J)));
739 for J in 0 .. UI_Power_10_Set loop
740 Tree_Read_Int (Int (UI_Power_10 (J)));
749 procedure Tree_Write is
754 Tree_Write_Int (Int (Uint_Int_First));
755 Tree_Write_Int (Int (Uint_Int_Last));
756 Tree_Write_Int (UI_Power_2_Set);
757 Tree_Write_Int (UI_Power_10_Set);
758 Tree_Write_Int (Int (Uints_Min));
759 Tree_Write_Int (Udigits_Min);
761 for J in 0 .. UI_Power_2_Set loop
762 Tree_Write_Int (Int (UI_Power_2 (J)));
765 for J in 0 .. UI_Power_10_Set loop
766 Tree_Write_Int (Int (UI_Power_10 (J)));
775 function UI_Abs (Right : Uint) return Uint is
777 if Right < Uint_0 then
788 function UI_Add (Left : Int; Right : Uint) return Uint is
790 return UI_Add (UI_From_Int (Left), Right);
793 function UI_Add (Left : Uint; Right : Int) return Uint is
795 return UI_Add (Left, UI_From_Int (Right));
798 function UI_Add (Left : Uint; Right : Uint) return Uint is
800 -- Simple cases of direct operands and addition of zero
802 if Direct (Left) then
803 if Direct (Right) then
804 return UI_From_Int (Direct_Val (Left) + Direct_Val (Right));
806 elsif Int (Left) = Int (Uint_0) then
810 elsif Direct (Right) and then Int (Right) = Int (Uint_0) then
814 -- Otherwise full circuit is needed
817 L_Length : constant Int := N_Digits (Left);
818 R_Length : constant Int := N_Digits (Right);
819 L_Vec : UI_Vector (1 .. L_Length);
820 R_Vec : UI_Vector (1 .. R_Length);
825 X_Bigger : Boolean := False;
826 Y_Bigger : Boolean := False;
827 Result_Neg : Boolean := False;
830 Init_Operand (Left, L_Vec);
831 Init_Operand (Right, R_Vec);
833 -- At least one of the two operands is in multi-digit form.
834 -- Calculate the number of digits sufficient to hold result.
836 if L_Length > R_Length then
837 Sum_Length := L_Length + 1;
840 Sum_Length := R_Length + 1;
842 if R_Length > L_Length then
847 -- Make copies of the absolute values of L_Vec and R_Vec into X and Y
848 -- both with lengths equal to the maximum possibly needed. This makes
849 -- looping over the digits much simpler.
852 X : UI_Vector (1 .. Sum_Length);
853 Y : UI_Vector (1 .. Sum_Length);
854 Tmp_UI : UI_Vector (1 .. Sum_Length);
857 for J in 1 .. Sum_Length - L_Length loop
861 X (Sum_Length - L_Length + 1) := abs L_Vec (1);
863 for J in 2 .. L_Length loop
864 X (J + (Sum_Length - L_Length)) := L_Vec (J);
867 for J in 1 .. Sum_Length - R_Length loop
871 Y (Sum_Length - R_Length + 1) := abs R_Vec (1);
873 for J in 2 .. R_Length loop
874 Y (J + (Sum_Length - R_Length)) := R_Vec (J);
877 if (L_Vec (1) < Int_0) = (R_Vec (1) < Int_0) then
879 -- Same sign so just add
882 for J in reverse 1 .. Sum_Length loop
883 Tmp_Int := X (J) + Y (J) + Carry;
885 if Tmp_Int >= Base then
886 Tmp_Int := Tmp_Int - Base;
895 return Vector_To_Uint (X, L_Vec (1) < Int_0);
898 -- Find which one has bigger magnitude
900 if not (X_Bigger or Y_Bigger) then
901 for J in L_Vec'Range loop
902 if abs L_Vec (J) > abs R_Vec (J) then
905 elsif abs R_Vec (J) > abs L_Vec (J) then
912 -- If they have identical magnitude, just return 0, else swap
913 -- if necessary so that X had the bigger magnitude. Determine
914 -- if result is negative at this time.
918 if not (X_Bigger or Y_Bigger) then
922 if R_Vec (1) < Int_0 then
931 if L_Vec (1) < Int_0 then
936 -- Subtract Y from the bigger X
940 for J in reverse 1 .. Sum_Length loop
941 Tmp_Int := X (J) - Y (J) + Borrow;
943 if Tmp_Int < Int_0 then
944 Tmp_Int := Tmp_Int + Base;
953 return Vector_To_Uint (X, Result_Neg);
960 --------------------------
961 -- UI_Decimal_Digits_Hi --
962 --------------------------
964 function UI_Decimal_Digits_Hi (U : Uint) return Nat is
966 -- The maximum value of a "digit" is 32767, which is 5 decimal digits,
967 -- so an N_Digit number could take up to 5 times this number of digits.
968 -- This is certainly too high for large numbers but it is not worth
971 return 5 * N_Digits (U);
972 end UI_Decimal_Digits_Hi;
974 --------------------------
975 -- UI_Decimal_Digits_Lo --
976 --------------------------
978 function UI_Decimal_Digits_Lo (U : Uint) return Nat is
980 -- The maximum value of a "digit" is 32767, which is more than four
981 -- decimal digits, but not a full five digits. The easily computed
982 -- minimum number of decimal digits is thus 1 + 4 * the number of
983 -- digits. This is certainly too low for large numbers but it is not
984 -- worth worrying about.
986 return 1 + 4 * (N_Digits (U) - 1);
987 end UI_Decimal_Digits_Lo;
993 function UI_Div (Left : Int; Right : Uint) return Uint is
995 return UI_Div (UI_From_Int (Left), Right);
998 function UI_Div (Left : Uint; Right : Int) return Uint is
1000 return UI_Div (Left, UI_From_Int (Right));
1003 function UI_Div (Left, Right : Uint) return Uint is
1006 pragma Warnings (Off, Remainder);
1010 Quotient, Remainder,
1011 Discard_Remainder => True);
1019 procedure UI_Div_Rem
1020 (Left, Right : Uint;
1021 Quotient : out Uint;
1022 Remainder : out Uint;
1023 Discard_Quotient : Boolean := False;
1024 Discard_Remainder : Boolean := False)
1027 pragma Assert (Right /= Uint_0);
1029 Quotient := No_Uint;
1030 Remainder := No_Uint;
1032 -- Cases where both operands are represented directly
1034 if Direct (Left) and then Direct (Right) then
1036 DV_Left : constant Int := Direct_Val (Left);
1037 DV_Right : constant Int := Direct_Val (Right);
1040 if not Discard_Quotient then
1041 Quotient := UI_From_Int (DV_Left / DV_Right);
1044 if not Discard_Remainder then
1045 Remainder := UI_From_Int (DV_Left rem DV_Right);
1053 L_Length : constant Int := N_Digits (Left);
1054 R_Length : constant Int := N_Digits (Right);
1055 Q_Length : constant Int := L_Length - R_Length + 1;
1056 L_Vec : UI_Vector (1 .. L_Length);
1057 R_Vec : UI_Vector (1 .. R_Length);
1065 procedure UI_Div_Vector
1068 Quotient : out UI_Vector;
1069 Remainder : out Int);
1070 pragma Inline (UI_Div_Vector);
1071 -- Specialised variant for case where the divisor is a single digit
1073 procedure UI_Div_Vector
1076 Quotient : out UI_Vector;
1077 Remainder : out Int)
1083 for J in L_Vec'Range loop
1084 Tmp_Int := Remainder * Base + abs L_Vec (J);
1085 Quotient (Quotient'First + J - L_Vec'First) := Tmp_Int / R_Int;
1086 Remainder := Tmp_Int rem R_Int;
1089 if L_Vec (L_Vec'First) < Int_0 then
1090 Remainder := -Remainder;
1094 -- Start of processing for UI_Div_Rem
1097 -- Result is zero if left operand is shorter than right
1099 if L_Length < R_Length then
1100 if not Discard_Quotient then
1104 if not Discard_Remainder then
1111 Init_Operand (Left, L_Vec);
1112 Init_Operand (Right, R_Vec);
1114 -- Case of right operand is single digit. Here we can simply divide
1115 -- each digit of the left operand by the divisor, from most to least
1116 -- significant, carrying the remainder to the next digit (just like
1117 -- ordinary long division by hand).
1119 if R_Length = Int_1 then
1120 Tmp_Divisor := abs R_Vec (1);
1123 Quotient_V : UI_Vector (1 .. L_Length);
1126 UI_Div_Vector (L_Vec, Tmp_Divisor, Quotient_V, Remainder_I);
1128 if not Discard_Quotient then
1131 (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1134 if not Discard_Remainder then
1135 Remainder := UI_From_Int (Remainder_I);
1142 -- The possible simple cases have been exhausted. Now turn to the
1143 -- algorithm D from the section of Knuth mentioned at the top of
1146 Algorithm_D : declare
1147 Dividend : UI_Vector (1 .. L_Length + 1);
1148 Divisor : UI_Vector (1 .. R_Length);
1149 Quotient_V : UI_Vector (1 .. Q_Length);
1156 -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1157 -- scale d, and then multiply Left and Right (u and v in the book)
1158 -- by d to get the dividend and divisor to work with.
1160 D := Base / (abs R_Vec (1) + 1);
1163 Dividend (2) := abs L_Vec (1);
1165 for J in 3 .. L_Length + Int_1 loop
1166 Dividend (J) := L_Vec (J - 1);
1169 Divisor (1) := abs R_Vec (1);
1171 for J in Int_2 .. R_Length loop
1172 Divisor (J) := R_Vec (J);
1177 -- Multiply Dividend by d
1180 for J in reverse Dividend'Range loop
1181 Tmp_Int := Dividend (J) * D + Carry;
1182 Dividend (J) := Tmp_Int rem Base;
1183 Carry := Tmp_Int / Base;
1186 -- Multiply Divisor by d
1189 for J in reverse Divisor'Range loop
1190 Tmp_Int := Divisor (J) * D + Carry;
1191 Divisor (J) := Tmp_Int rem Base;
1192 Carry := Tmp_Int / Base;
1196 -- Main loop of long division algorithm
1198 Divisor_Dig1 := Divisor (1);
1199 Divisor_Dig2 := Divisor (2);
1201 for J in Quotient_V'Range loop
1203 -- [ CALCULATE Q (hat) ] (step D3 in the algorithm)
1205 -- Note: this version of step D3 is from the original published
1206 -- algorithm, which is known to have a bug causing overflows.
1207 -- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz
1208 -- and http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz.
1209 -- The code below is the fixed version of this step.
1211 Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
1215 Q_Guess := Tmp_Int / Divisor_Dig1;
1216 R_Guess := Tmp_Int rem Divisor_Dig1;
1220 while Q_Guess >= Base
1221 or else Divisor_Dig2 * Q_Guess >
1222 R_Guess * Base + Dividend (J + 2)
1224 Q_Guess := Q_Guess - 1;
1225 R_Guess := R_Guess + Divisor_Dig1;
1226 exit when R_Guess >= Base;
1229 -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
1230 -- subtracted from the remaining dividend.
1233 for K in reverse Divisor'Range loop
1234 Tmp_Int := Dividend (J + K) - Q_Guess * Divisor (K) + Carry;
1235 Tmp_Dig := Tmp_Int rem Base;
1236 Carry := Tmp_Int / Base;
1238 if Tmp_Dig < Int_0 then
1239 Tmp_Dig := Tmp_Dig + Base;
1243 Dividend (J + K) := Tmp_Dig;
1246 Dividend (J) := Dividend (J) + Carry;
1248 -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
1250 -- Here there is a slight difference from the book: the last
1251 -- carry is always added in above and below (cancelling each
1252 -- other). In fact the dividend going negative is used as
1255 -- If the Dividend went negative, then Q_Guess was off by
1256 -- one, so it is decremented, and the divisor is added back
1257 -- into the relevant portion of the dividend.
1259 if Dividend (J) < Int_0 then
1260 Q_Guess := Q_Guess - 1;
1263 for K in reverse Divisor'Range loop
1264 Tmp_Int := Dividend (J + K) + Divisor (K) + Carry;
1266 if Tmp_Int >= Base then
1267 Tmp_Int := Tmp_Int - Base;
1273 Dividend (J + K) := Tmp_Int;
1276 Dividend (J) := Dividend (J) + Carry;
1279 -- Finally we can get the next quotient digit
1281 Quotient_V (J) := Q_Guess;
1284 -- [ UNNORMALIZE ] (step D8)
1286 if not Discard_Quotient then
1287 Quotient := Vector_To_Uint
1288 (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1291 if not Discard_Remainder then
1293 Remainder_V : UI_Vector (1 .. R_Length);
1295 pragma Warnings (Off, Discard_Int);
1297 pragma Assert (D /= Int'(0));
1299 (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last),
1301 Remainder_V, Discard_Int);
1302 Remainder := Vector_To_Uint (Remainder_V, L_Vec (1) < Int_0);
1313 function UI_Eq (Left : Int; Right : Uint) return Boolean is
1315 return not UI_Ne (UI_From_Int (Left), Right);
1318 function UI_Eq (Left : Uint; Right : Int) return Boolean is
1320 return not UI_Ne (Left, UI_From_Int (Right));
1323 function UI_Eq (Left : Uint; Right : Uint) return Boolean is
1325 return not UI_Ne (Left, Right);
1332 function UI_Expon (Left : Int; Right : Uint) return Uint is
1334 return UI_Expon (UI_From_Int (Left), Right);
1337 function UI_Expon (Left : Uint; Right : Int) return Uint is
1339 return UI_Expon (Left, UI_From_Int (Right));
1342 function UI_Expon (Left : Int; Right : Int) return Uint is
1344 return UI_Expon (UI_From_Int (Left), UI_From_Int (Right));
1347 function UI_Expon (Left : Uint; Right : Uint) return Uint is
1349 pragma Assert (Right >= Uint_0);
1351 -- Any value raised to power of 0 is 1
1353 if Right = Uint_0 then
1356 -- 0 to any positive power is 0
1358 elsif Left = Uint_0 then
1361 -- 1 to any power is 1
1363 elsif Left = Uint_1 then
1366 -- Any value raised to power of 1 is that value
1368 elsif Right = Uint_1 then
1371 -- Cases which can be done by table lookup
1373 elsif Right <= Uint_64 then
1375 -- 2**N for N in 2 .. 64
1377 if Left = Uint_2 then
1379 Right_Int : constant Int := Direct_Val (Right);
1382 if Right_Int > UI_Power_2_Set then
1383 for J in UI_Power_2_Set + Int_1 .. Right_Int loop
1384 UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2;
1385 Uints_Min := Uints.Last;
1386 Udigits_Min := Udigits.Last;
1389 UI_Power_2_Set := Right_Int;
1392 return UI_Power_2 (Right_Int);
1395 -- 10**N for N in 2 .. 64
1397 elsif Left = Uint_10 then
1399 Right_Int : constant Int := Direct_Val (Right);
1402 if Right_Int > UI_Power_10_Set then
1403 for J in UI_Power_10_Set + Int_1 .. Right_Int loop
1404 UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10);
1405 Uints_Min := Uints.Last;
1406 Udigits_Min := Udigits.Last;
1409 UI_Power_10_Set := Right_Int;
1412 return UI_Power_10 (Right_Int);
1417 -- If we fall through, then we have the general case (see Knuth 4.6.3)
1421 Squares : Uint := Left;
1422 Result : Uint := Uint_1;
1423 M : constant Uintp.Save_Mark := Uintp.Mark;
1427 if (Least_Sig_Digit (N) mod Int_2) = Int_1 then
1428 Result := Result * Squares;
1432 exit when N = Uint_0;
1433 Squares := Squares * Squares;
1436 Uintp.Release_And_Save (M, Result);
1445 function UI_From_CC (Input : Char_Code) return Uint is
1447 return UI_From_Int (Int (Input));
1454 function UI_From_Int (Input : Int) return Uint is
1458 if Min_Direct <= Input and then Input <= Max_Direct then
1459 return Uint (Int (Uint_Direct_Bias) + Input);
1462 -- If already in the hash table, return entry
1464 U := UI_Ints.Get (Input);
1466 if U /= No_Uint then
1470 -- For values of larger magnitude, compute digits into a vector and call
1474 Max_For_Int : constant := 3;
1475 -- Base is defined so that 3 Uint digits is sufficient to hold the
1476 -- largest possible Int value.
1478 V : UI_Vector (1 .. Max_For_Int);
1480 Temp_Integer : Int := Input;
1483 for J in reverse V'Range loop
1484 V (J) := abs (Temp_Integer rem Base);
1485 Temp_Integer := Temp_Integer / Base;
1488 U := Vector_To_Uint (V, Input < Int_0);
1489 UI_Ints.Set (Input, U);
1490 Uints_Min := Uints.Last;
1491 Udigits_Min := Udigits.Last;
1496 ----------------------
1497 -- UI_From_Integral --
1498 ----------------------
1500 function UI_From_Integral (Input : In_T) return Uint is
1502 -- If in range of our normal conversion function, use it so we can use
1503 -- direct access and our cache.
1505 if In_T'Size <= Int'Size
1506 or else Input in In_T (Int'First) .. In_T (Int'Last)
1508 return UI_From_Int (Int (Input));
1511 -- For values of larger magnitude, compute digits into a vector and
1512 -- call Vector_To_Uint.
1515 Max_For_In_T : constant Int := 3 * In_T'Size / Int'Size;
1516 Our_Base : constant In_T := In_T (Base);
1517 Temp_Integer : In_T := Input;
1518 -- Base is defined so that 3 Uint digits is sufficient to hold the
1519 -- largest possible Int value.
1522 V : UI_Vector (1 .. Max_For_In_T);
1525 for J in reverse V'Range loop
1526 V (J) := Int (abs (Temp_Integer rem Our_Base));
1527 Temp_Integer := Temp_Integer / Our_Base;
1530 U := Vector_To_Uint (V, Input < 0);
1531 Uints_Min := Uints.Last;
1532 Udigits_Min := Udigits.Last;
1537 end UI_From_Integral;
1543 -- Lehmer's algorithm for GCD
1545 -- The idea is to avoid using multiple precision arithmetic wherever
1546 -- possible, substituting Int arithmetic instead. See Knuth volume II,
1547 -- Algorithm L (page 329).
1549 -- We use the same notation as Knuth (U_Hat standing for the obvious)
1551 function UI_GCD (Uin, Vin : Uint) return Uint is
1553 -- Copies of Uin and Vin
1556 -- The most Significant digits of U,V
1558 A, B, C, D, T, Q, Den1, Den2 : Int;
1561 Marks : constant Uintp.Save_Mark := Uintp.Mark;
1562 Iterations : Integer := 0;
1565 pragma Assert (Uin >= Vin);
1566 pragma Assert (Vin >= Uint_0);
1572 Iterations := Iterations + 1;
1579 UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V)));
1583 Most_Sig_2_Digits (U, V, U_Hat, V_Hat);
1590 -- We might overflow and get division by zero here. This just
1591 -- means we cannot take the single precision step
1595 exit when Den1 = Int_0 or else Den2 = Int_0;
1597 -- Compute Q, the trial quotient
1599 Q := (U_Hat + A) / Den1;
1601 exit when Q /= ((U_Hat + B) / Den2);
1603 -- A single precision step Euclid step will give same answer as a
1604 -- multiprecision one.
1614 T := U_Hat - (Q * V_Hat);
1620 -- Take a multiprecision Euclid step
1624 -- No single precision steps take a regular Euclid step
1631 -- Use prior single precision steps to compute this Euclid step
1633 Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V);
1634 V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V);
1638 -- If the operands are very different in magnitude, the loop will
1639 -- generate large amounts of short-lived data, which it is worth
1640 -- removing periodically.
1642 if Iterations > 100 then
1643 Release_And_Save (Marks, U, V);
1653 function UI_Ge (Left : Int; Right : Uint) return Boolean is
1655 return not UI_Lt (UI_From_Int (Left), Right);
1658 function UI_Ge (Left : Uint; Right : Int) return Boolean is
1660 return not UI_Lt (Left, UI_From_Int (Right));
1663 function UI_Ge (Left : Uint; Right : Uint) return Boolean is
1665 return not UI_Lt (Left, Right);
1672 function UI_Gt (Left : Int; Right : Uint) return Boolean is
1674 return UI_Lt (Right, UI_From_Int (Left));
1677 function UI_Gt (Left : Uint; Right : Int) return Boolean is
1679 return UI_Lt (UI_From_Int (Right), Left);
1682 function UI_Gt (Left : Uint; Right : Uint) return Boolean is
1684 return UI_Lt (Left => Right, Right => Left);
1691 procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
1693 Image_Out (Input, True, Format);
1698 Format : UI_Format := Auto) return String
1701 Image_Out (Input, True, Format);
1702 return UI_Image_Buffer (1 .. UI_Image_Length);
1705 -------------------------
1706 -- UI_Is_In_Int_Range --
1707 -------------------------
1709 function UI_Is_In_Int_Range (Input : Uint) return Boolean is
1711 -- Make sure we don't get called before Initialize
1713 pragma Assert (Uint_Int_First /= Uint_0);
1715 if Direct (Input) then
1718 return Input >= Uint_Int_First
1719 and then Input <= Uint_Int_Last;
1721 end UI_Is_In_Int_Range;
1727 function UI_Le (Left : Int; Right : Uint) return Boolean is
1729 return not UI_Lt (Right, UI_From_Int (Left));
1732 function UI_Le (Left : Uint; Right : Int) return Boolean is
1734 return not UI_Lt (UI_From_Int (Right), Left);
1737 function UI_Le (Left : Uint; Right : Uint) return Boolean is
1739 return not UI_Lt (Left => Right, Right => Left);
1746 function UI_Lt (Left : Int; Right : Uint) return Boolean is
1748 return UI_Lt (UI_From_Int (Left), Right);
1751 function UI_Lt (Left : Uint; Right : Int) return Boolean is
1753 return UI_Lt (Left, UI_From_Int (Right));
1756 function UI_Lt (Left : Uint; Right : Uint) return Boolean is
1758 -- Quick processing for identical arguments
1760 if Int (Left) = Int (Right) then
1763 -- Quick processing for both arguments directly represented
1765 elsif Direct (Left) and then Direct (Right) then
1766 return Int (Left) < Int (Right);
1768 -- At least one argument is more than one digit long
1772 L_Length : constant Int := N_Digits (Left);
1773 R_Length : constant Int := N_Digits (Right);
1775 L_Vec : UI_Vector (1 .. L_Length);
1776 R_Vec : UI_Vector (1 .. R_Length);
1779 Init_Operand (Left, L_Vec);
1780 Init_Operand (Right, R_Vec);
1782 if L_Vec (1) < Int_0 then
1784 -- First argument negative, second argument non-negative
1786 if R_Vec (1) >= Int_0 then
1789 -- Both arguments negative
1792 if L_Length /= R_Length then
1793 return L_Length > R_Length;
1795 elsif L_Vec (1) /= R_Vec (1) then
1796 return L_Vec (1) < R_Vec (1);
1799 for J in 2 .. L_Vec'Last loop
1800 if L_Vec (J) /= R_Vec (J) then
1801 return L_Vec (J) > R_Vec (J);
1810 -- First argument non-negative, second argument negative
1812 if R_Vec (1) < Int_0 then
1815 -- Both arguments non-negative
1818 if L_Length /= R_Length then
1819 return L_Length < R_Length;
1821 for J in L_Vec'Range loop
1822 if L_Vec (J) /= R_Vec (J) then
1823 return L_Vec (J) < R_Vec (J);
1839 function UI_Max (Left : Int; Right : Uint) return Uint is
1841 return UI_Max (UI_From_Int (Left), Right);
1844 function UI_Max (Left : Uint; Right : Int) return Uint is
1846 return UI_Max (Left, UI_From_Int (Right));
1849 function UI_Max (Left : Uint; Right : Uint) return Uint is
1851 if Left >= Right then
1862 function UI_Min (Left : Int; Right : Uint) return Uint is
1864 return UI_Min (UI_From_Int (Left), Right);
1867 function UI_Min (Left : Uint; Right : Int) return Uint is
1869 return UI_Min (Left, UI_From_Int (Right));
1872 function UI_Min (Left : Uint; Right : Uint) return Uint is
1874 if Left <= Right then
1885 function UI_Mod (Left : Int; Right : Uint) return Uint is
1887 return UI_Mod (UI_From_Int (Left), Right);
1890 function UI_Mod (Left : Uint; Right : Int) return Uint is
1892 return UI_Mod (Left, UI_From_Int (Right));
1895 function UI_Mod (Left : Uint; Right : Uint) return Uint is
1896 Urem : constant Uint := Left rem Right;
1899 if (Left < Uint_0) = (Right < Uint_0)
1900 or else Urem = Uint_0
1904 return Right + Urem;
1908 -------------------------------
1909 -- UI_Modular_Exponentiation --
1910 -------------------------------
1912 function UI_Modular_Exponentiation
1915 Modulo : Uint) return Uint
1917 M : constant Save_Mark := Mark;
1919 Result : Uint := Uint_1;
1921 Exponent : Uint := E;
1924 while Exponent /= Uint_0 loop
1925 if Least_Sig_Digit (Exponent) rem Int'(2) = Int'(1) then
1926 Result := (Result * Base) rem Modulo;
1929 Exponent := Exponent / Uint_2;
1930 Base := (Base * Base) rem Modulo;
1933 Release_And_Save (M, Result);
1935 end UI_Modular_Exponentiation;
1937 ------------------------
1938 -- UI_Modular_Inverse --
1939 ------------------------
1941 function UI_Modular_Inverse (N : Uint; Modulo : Uint) return Uint is
1942 M : constant Save_Mark := Mark;
1960 UI_Div_Rem (U, V, Quotient => Q, Remainder => R);
1970 exit when R = Uint_1;
1973 if S = Int'(-1) then
1977 Release_And_Save (M, X);
1979 end UI_Modular_Inverse;
1985 function UI_Mul (Left : Int; Right : Uint) return Uint is
1987 return UI_Mul (UI_From_Int (Left), Right);
1990 function UI_Mul (Left : Uint; Right : Int) return Uint is
1992 return UI_Mul (Left, UI_From_Int (Right));
1995 function UI_Mul (Left : Uint; Right : Uint) return Uint is
1997 -- Case where product fits in the range of a 32-bit integer
1999 if Int (Left) <= Int (Uint_Max_Simple_Mul)
2001 Int (Right) <= Int (Uint_Max_Simple_Mul)
2003 return UI_From_Int (Direct_Val (Left) * Direct_Val (Right));
2006 -- Otherwise we have the general case (Algorithm M in Knuth)
2009 L_Length : constant Int := N_Digits (Left);
2010 R_Length : constant Int := N_Digits (Right);
2011 L_Vec : UI_Vector (1 .. L_Length);
2012 R_Vec : UI_Vector (1 .. R_Length);
2016 Init_Operand (Left, L_Vec);
2017 Init_Operand (Right, R_Vec);
2018 Neg := (L_Vec (1) < Int_0) xor (R_Vec (1) < Int_0);
2019 L_Vec (1) := abs (L_Vec (1));
2020 R_Vec (1) := abs (R_Vec (1));
2022 Algorithm_M : declare
2023 Product : UI_Vector (1 .. L_Length + R_Length);
2028 for J in Product'Range loop
2032 for J in reverse R_Vec'Range loop
2034 for K in reverse L_Vec'Range loop
2036 L_Vec (K) * R_Vec (J) + Product (J + K) + Carry;
2037 Product (J + K) := Tmp_Sum rem Base;
2038 Carry := Tmp_Sum / Base;
2041 Product (J) := Carry;
2044 return Vector_To_Uint (Product, Neg);
2053 function UI_Ne (Left : Int; Right : Uint) return Boolean is
2055 return UI_Ne (UI_From_Int (Left), Right);
2058 function UI_Ne (Left : Uint; Right : Int) return Boolean is
2060 return UI_Ne (Left, UI_From_Int (Right));
2063 function UI_Ne (Left : Uint; Right : Uint) return Boolean is
2065 -- Quick processing for identical arguments. Note that this takes
2066 -- care of the case of two No_Uint arguments.
2068 if Int (Left) = Int (Right) then
2072 -- See if left operand directly represented
2074 if Direct (Left) then
2076 -- If right operand directly represented then compare
2078 if Direct (Right) then
2079 return Int (Left) /= Int (Right);
2081 -- Left operand directly represented, right not, must be unequal
2087 -- Right operand directly represented, left not, must be unequal
2089 elsif Direct (Right) then
2093 -- Otherwise both multi-word, do comparison
2096 Size : constant Int := N_Digits (Left);
2101 if Size /= N_Digits (Right) then
2105 Left_Loc := Uints.Table (Left).Loc;
2106 Right_Loc := Uints.Table (Right).Loc;
2108 for J in Int_0 .. Size - Int_1 loop
2109 if Udigits.Table (Left_Loc + J) /=
2110 Udigits.Table (Right_Loc + J)
2124 function UI_Negate (Right : Uint) return Uint is
2126 -- Case where input is directly represented. Note that since the range
2127 -- of Direct values is non-symmetrical, the result may not be directly
2128 -- represented, this is taken care of in UI_From_Int.
2130 if Direct (Right) then
2131 return UI_From_Int (-Direct_Val (Right));
2133 -- Full processing for multi-digit case. Note that we cannot just copy
2134 -- the value to the end of the table negating the first digit, since the
2135 -- range of Direct values is non-symmetrical, so we can have a negative
2136 -- value that is not Direct whose negation can be represented directly.
2140 R_Length : constant Int := N_Digits (Right);
2141 R_Vec : UI_Vector (1 .. R_Length);
2145 Init_Operand (Right, R_Vec);
2146 Neg := R_Vec (1) > Int_0;
2147 R_Vec (1) := abs R_Vec (1);
2148 return Vector_To_Uint (R_Vec, Neg);
2157 function UI_Rem (Left : Int; Right : Uint) return Uint is
2159 return UI_Rem (UI_From_Int (Left), Right);
2162 function UI_Rem (Left : Uint; Right : Int) return Uint is
2164 return UI_Rem (Left, UI_From_Int (Right));
2167 function UI_Rem (Left, Right : Uint) return Uint is
2170 pragma Warnings (Off, Quotient);
2173 pragma Assert (Right /= Uint_0);
2175 if Direct (Right) and then Direct (Left) then
2176 return UI_From_Int (Direct_Val (Left) rem Direct_Val (Right));
2180 (Left, Right, Quotient, Remainder, Discard_Quotient => True);
2189 function UI_Sub (Left : Int; Right : Uint) return Uint is
2191 return UI_Add (Left, -Right);
2194 function UI_Sub (Left : Uint; Right : Int) return Uint is
2196 return UI_Add (Left, -Right);
2199 function UI_Sub (Left : Uint; Right : Uint) return Uint is
2201 if Direct (Left) and then Direct (Right) then
2202 return UI_From_Int (Direct_Val (Left) - Direct_Val (Right));
2204 return UI_Add (Left, -Right);
2212 function UI_To_CC (Input : Uint) return Char_Code is
2214 if Direct (Input) then
2215 return Char_Code (Direct_Val (Input));
2217 -- Case of input is more than one digit
2221 In_Length : constant Int := N_Digits (Input);
2222 In_Vec : UI_Vector (1 .. In_Length);
2226 Init_Operand (Input, In_Vec);
2228 -- We assume value is positive
2231 for Idx in In_Vec'Range loop
2232 Ret_CC := Ret_CC * Char_Code (Base) +
2233 Char_Code (abs In_Vec (Idx));
2245 function UI_To_Int (Input : Uint) return Int is
2246 pragma Assert (Input /= No_Uint);
2249 if Direct (Input) then
2250 return Direct_Val (Input);
2252 -- Case of input is more than one digit
2256 In_Length : constant Int := N_Digits (Input);
2257 In_Vec : UI_Vector (1 .. In_Length);
2261 -- Uints of more than one digit could be outside the range for
2262 -- Ints. Caller should have checked for this if not certain.
2263 -- Constraint_Error to attempt to convert from value outside
2266 if not UI_Is_In_Int_Range (Input) then
2267 raise Constraint_Error;
2270 -- Otherwise, proceed ahead, we are OK
2272 Init_Operand (Input, In_Vec);
2275 -- Calculate -|Input| and then negates if value is positive. This
2276 -- handles our current definition of Int (based on 2s complement).
2277 -- Is it secure enough???
2279 for Idx in In_Vec'Range loop
2280 Ret_Int := Ret_Int * Base - abs In_Vec (Idx);
2283 if In_Vec (1) < Int_0 then
2296 procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is
2298 Image_Out (Input, False, Format);
2301 ---------------------
2302 -- Vector_To_Uint --
2303 ---------------------
2305 function Vector_To_Uint
2306 (In_Vec : UI_Vector;
2314 -- The vector can contain leading zeros. These are not stored in the
2315 -- table, so loop through the vector looking for first non-zero digit
2317 for J in In_Vec'Range loop
2318 if In_Vec (J) /= Int_0 then
2320 -- The length of the value is the length of the rest of the vector
2322 Size := In_Vec'Last - J + 1;
2324 -- One digit value can always be represented directly
2326 if Size = Int_1 then
2328 return Uint (Int (Uint_Direct_Bias) - In_Vec (J));
2330 return Uint (Int (Uint_Direct_Bias) + In_Vec (J));
2333 -- Positive two digit values may be in direct representation range
2335 elsif Size = Int_2 and then not Negative then
2336 Val := In_Vec (J) * Base + In_Vec (J + 1);
2338 if Val <= Max_Direct then
2339 return Uint (Int (Uint_Direct_Bias) + Val);
2343 -- The value is outside the direct representation range and must
2344 -- therefore be stored in the table. Expand the table to contain
2345 -- the count and digits. The index of the new table entry will be
2346 -- returned as the result.
2348 Uints.Append ((Length => Size, Loc => Udigits.Last + 1));
2356 Udigits.Append (Val);
2358 for K in 2 .. Size loop
2359 Udigits.Append (In_Vec (J + K - 1));
2366 -- Dropped through loop only if vector contained all zeros