1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2005 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
50 -- value, 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
74 -- does not destroy values saved in the U_Power tables or in the hash
75 -- table used by UI_From_Int. Whenever an entry is made in either of
76 -- these tabls, Uints_Min and Udigits_Min are updated to protect the
77 -- entry, and Release 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
90 -- wasting storage. This is particularly important for complex cases
91 -- of back annotation.
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
116 -- is the 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
126 -- True for UI_Image, and false for UI_Write, and Format is copied
127 -- from the Format 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
133 -- size as determined by a previous call to N_Digits (UI). The first
134 -- digit of Vec contains the sign, all other digits are always non-
135 -- negative. Note that the input may be directly represented, and in
136 -- this case Vec will contain the corresponding one or two digit value.
138 function Least_Sig_Digit
(Arg
: Uint
) return Int
;
139 pragma Inline
(Least_Sig_Digit
);
140 -- Returns the Least Significant Digit of Arg quickly. When the given
141 -- Uint is less than 2**15, the value returned is the input value, in
142 -- this case the result may be negative. It is expected that any use
143 -- will mask off unnecessary bits. This is used for finding Arg mod B
144 -- where B is a power of two. Hence the actual base is irrelevent as
145 -- long as it is a power of two.
147 procedure Most_Sig_2_Digits
151 Right_Hat
: out Int
);
152 -- Returns leading two significant digits from the given pair of Uint's.
153 -- Mathematically: returns Left / (Base ** K) and Right / (Base ** K)
154 -- where K is as small as possible S.T. Right_Hat < Base * Base.
155 -- It is required that Left > Right for the algorithm to work.
157 function N_Digits
(Input
: Uint
) return Int
;
158 pragma Inline
(N_Digits
);
159 -- Returns number of "digits" in a Uint
161 function Sum_Digits
(Left
: Uint
; Sign
: Int
) return Int
;
162 -- If Sign = 1 return the sum of the "digits" of Abs (Left). If the
163 -- total has more then one digit then return Sum_Digits of total.
165 function Sum_Double_Digits
(Left
: Uint
; Sign
: Int
) return Int
;
166 -- Same as above but work in New_Base = Base * Base
168 function Vector_To_Uint
172 -- Functions that calculate values in UI_Vectors, call this function
173 -- to create and return the Uint value. In_Vec contains the multiple
174 -- precision (Base) representation of a non-negative value. Leading
175 -- zeroes are permitted. Negative is set if the desired result is
176 -- the negative of the given value. The result will be either the
177 -- appropriate directly represented value, or a table entry in the
178 -- proper canonical format is created and returned.
180 -- Note that Init_Operand puts a signed value in the result vector,
181 -- but Vector_To_Uint is always presented with a non-negative value.
182 -- The processing of signs is something that is done by the caller
183 -- before calling Vector_To_Uint.
189 function Direct
(U
: Uint
) return Boolean is
191 return Int
(U
) <= Int
(Uint_Direct_Last
);
198 function Direct_Val
(U
: Uint
) return Int
is
200 pragma Assert
(Direct
(U
));
201 return Int
(U
) - Int
(Uint_Direct_Bias
);
208 function GCD
(Jin
, Kin
: Int
) return Int
is
212 pragma Assert
(Jin
>= Kin
);
213 pragma Assert
(Kin
>= Int_0
);
218 while K
/= Uint_0
loop
231 function Hash_Num
(F
: Int
) return Hnum
is
233 return Standard
."mod" (F
, Hnum
'Range_Length);
245 Marks
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
249 Digs_Output
: Natural := 0;
250 -- Counts digits output. In hex mode, but not in decimal mode, we
251 -- put an underline after every four hex digits that are output.
253 Exponent
: Natural := 0;
254 -- If the number is too long to fit in the buffer, we switch to an
255 -- approximate output format with an exponent. This variable records
256 -- the exponent value.
258 function Better_In_Hex
return Boolean;
259 -- Determines if it is better to generate digits in base 16 (result
260 -- is true) or base 10 (result is false). The choice is purely a
261 -- matter of convenience and aesthetics, so it does not matter which
262 -- value is returned from a correctness point of view.
264 procedure Image_Char
(C
: Character);
265 -- Internal procedure to output one character
267 procedure Image_Exponent
(N
: Natural);
268 -- Output non-zero exponent. Note that we only use the exponent
269 -- form in the buffer case, so we know that To_Buffer is true.
271 procedure Image_Uint
(U
: Uint
);
272 -- Internal procedure to output characters of non-negative Uint
278 function Better_In_Hex
return Boolean is
279 T16
: constant Uint
:= Uint_2
** Int
'(16);
285 -- Small values up to 2**16 can always be in decimal
291 -- Otherwise, see if we are a power of 2 or one less than a power
292 -- of 2. For the moment these are the only cases printed in hex.
294 if A mod Uint_2 = Uint_1 then
299 if A mod T16 /= Uint_0 then
309 while A > Uint_2 loop
310 if A mod Uint_2 /= Uint_0 then
325 procedure Image_Char (C : Character) is
328 if UI_Image_Length + 6 > UI_Image_Max then
329 Exponent := Exponent + 1;
331 UI_Image_Length := UI_Image_Length + 1;
332 UI_Image_Buffer (UI_Image_Length) := C;
343 procedure Image_Exponent (N : Natural) is
346 Image_Exponent (N / 10);
349 UI_Image_Length := UI_Image_Length + 1;
350 UI_Image_Buffer (UI_Image_Length) :=
351 Character'Val (Character'Pos ('0') + N mod 10);
358 procedure Image_Uint (U : Uint) is
359 H : constant array (Int range 0 .. 15) of Character :=
364 Image_Uint (U / Base);
367 if Digs_Output = 4 and then Base = Uint_16 then
372 Image_Char (H (UI_To_Int (U rem Base)));
374 Digs_Output := Digs_Output + 1;
377 -- Start of processing for Image_Out
380 if Input = No_Uint then
385 UI_Image_Length := 0;
387 if Input < Uint_0 then
395 or else (Format = Auto and then Better_In_Hex)
409 if Exponent /= 0 then
410 UI_Image_Length := UI_Image_Length + 1;
411 UI_Image_Buffer (UI_Image_Length) := 'E
';
412 Image_Exponent (Exponent);
415 Uintp.Release (Marks);
422 procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
427 Vec (1) := Direct_Val (UI);
429 if Vec (1) >= Base then
430 Vec (2) := Vec (1) rem Base;
431 Vec (1) := Vec (1) / Base;
435 Loc := Uints.Table (UI).Loc;
437 for J in 1 .. Uints.Table (UI).Length loop
438 Vec (J) := Udigits.Table (Loc + J - 1);
447 procedure Initialize is
452 Uint_Int_First := UI_From_Int (Int'First);
453 Uint_Int_Last := UI_From_Int (Int'Last);
455 UI_Power_2 (0) := Uint_1;
458 UI_Power_10 (0) := Uint_1;
459 UI_Power_10_Set := 0;
461 Uints_Min := Uints.Last;
462 Udigits_Min := Udigits.Last;
467 ---------------------
468 -- Least_Sig_Digit --
469 ---------------------
471 function Least_Sig_Digit (Arg : Uint) return Int is
476 V := Direct_Val (Arg);
482 -- Note that this result may be negative
489 (Uints.Table (Arg).Loc + Uints.Table (Arg).Length - 1);
497 function Mark return Save_Mark is
499 return (Save_Uint => Uints.Last, Save_Udigit => Udigits.Last);
502 -----------------------
503 -- Most_Sig_2_Digits --
504 -----------------------
506 procedure Most_Sig_2_Digits
513 pragma Assert (Left >= Right);
515 if Direct (Left) then
516 Left_Hat := Direct_Val (Left);
517 Right_Hat := Direct_Val (Right);
523 Udigits.Table (Uints.Table (Left).Loc);
525 Udigits.Table (Uints.Table (Left).Loc + 1);
528 -- It is not so clear what to return when Arg is negative???
530 Left_Hat := abs (L1) * Base + L2;
535 Length_L : constant Int := Uints.Table (Left).Length;
542 if Direct (Right) then
543 T := Direct_Val (Left);
544 R1 := abs (T / Base);
549 R1 := abs (Udigits.Table (Uints.Table (Right).Loc));
550 R2 := Udigits.Table (Uints.Table (Right).Loc + 1);
551 Length_R := Uints.Table (Right).Length;
554 if Length_L = Length_R then
555 Right_Hat := R1 * Base + R2;
556 elsif Length_L = Length_R + Int_1 then
562 end Most_Sig_2_Digits;
568 -- Note: N_Digits returns 1 for No_Uint
570 function N_Digits (Input : Uint) return Int is
572 if Direct (Input) then
573 if Direct_Val (Input) >= Base then
580 return Uints.Table (Input).Length;
588 function Num_Bits (Input : Uint) return Nat is
593 if UI_Is_In_Int_Range (Input) then
594 Num := abs (UI_To_Int (Input));
598 Bits := Base_Bits * (Uints.Table (Input).Length - 1);
599 Num := abs (Udigits.Table (Uints.Table (Input).Loc));
602 while Types.">" (Num, 0) loop
614 procedure pid (Input : Uint) is
616 UI_Write (Input, Decimal);
624 procedure pih (Input : Uint) is
626 UI_Write (Input, Hex);
634 procedure Release (M : Save_Mark) is
636 Uints.Set_Last (Uint'Max (M.Save_Uint, Uints_Min));
637 Udigits.Set_Last (Int'Max (M.Save_Udigit, Udigits_Min));
640 ----------------------
641 -- Release_And_Save --
642 ----------------------
644 procedure Release_And_Save (M : Save_Mark; UI : in out Uint) is
651 UE_Len : constant Pos := Uints.Table (UI).Length;
652 UE_Loc : constant Int := Uints.Table (UI).Loc;
654 UD : constant Udigits.Table_Type (1 .. UE_Len) :=
655 Udigits.Table (UE_Loc .. UE_Loc + UE_Len - 1);
660 Uints.Increment_Last;
663 Uints.Table (UI) := (UE_Len, Udigits.Last + 1);
665 for J in 1 .. UE_Len loop
666 Udigits.Increment_Last;
667 Udigits.Table (Udigits.Last) := UD (J);
671 end Release_And_Save;
673 procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint) is
676 Release_And_Save (M, UI2);
678 elsif Direct (UI2) then
679 Release_And_Save (M, UI1);
683 UE1_Len : constant Pos := Uints.Table (UI1).Length;
684 UE1_Loc : constant Int := Uints.Table (UI1).Loc;
686 UD1 : constant Udigits.Table_Type (1 .. UE1_Len) :=
687 Udigits.Table (UE1_Loc .. UE1_Loc + UE1_Len - 1);
689 UE2_Len : constant Pos := Uints.Table (UI2).Length;
690 UE2_Loc : constant Int := Uints.Table (UI2).Loc;
692 UD2 : constant Udigits.Table_Type (1 .. UE2_Len) :=
693 Udigits.Table (UE2_Loc .. UE2_Loc + UE2_Len - 1);
698 Uints.Increment_Last;
701 Uints.Table (UI1) := (UE1_Len, Udigits.Last + 1);
703 for J in 1 .. UE1_Len loop
704 Udigits.Increment_Last;
705 Udigits.Table (Udigits.Last) := UD1 (J);
708 Uints.Increment_Last;
711 Uints.Table (UI2) := (UE2_Len, Udigits.Last + 1);
713 for J in 1 .. UE2_Len loop
714 Udigits.Increment_Last;
715 Udigits.Table (Udigits.Last) := UD2 (J);
719 end Release_And_Save;
725 -- This is done in one pass
727 -- Mathematically: assume base congruent to 1 and compute an equivelent
730 -- If Sign = -1 return the alternating sum of the "digits".
732 -- D1 - D2 + D3 - D4 + D5 . . .
734 -- (where D1 is Least Significant Digit)
736 -- Mathematically: assume base congruent to -1 and compute an equivelent
739 -- This is used in Rem and Base is assumed to be 2 ** 15
741 -- Note: The next two functions are very similar, any style changes made
742 -- to one should be reflected in both. These would be simpler if we
743 -- worked base 2 ** 32.
745 function Sum_Digits (Left : Uint; Sign : Int) return Int is
747 pragma Assert (Sign = Int_1 or Sign = Int (-1));
749 -- First try simple case;
751 if Direct (Left) then
753 Tmp_Int : Int := Direct_Val (Left);
756 if Tmp_Int >= Base then
757 Tmp_Int := (Tmp_Int / Base) +
758 Sign * (Tmp_Int rem Base);
760 -- Now Tmp_Int is in [-(Base - 1) .. 2 * (Base - 1)]
762 if Tmp_Int >= Base then
766 Tmp_Int := (Tmp_Int / Base) + 1;
770 -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
777 -- Otherwise full circuit is needed
781 L_Length : constant Int := N_Digits (Left);
782 L_Vec : UI_Vector (1 .. L_Length);
788 Init_Operand (Left, L_Vec);
789 L_Vec (1) := abs L_Vec (1);
794 for J in reverse 1 .. L_Length loop
795 Tmp_Int := Tmp_Int + Alt * (L_Vec (J) + Carry);
797 -- Tmp_Int is now between [-2 * Base + 1 .. 2 * Base - 1],
798 -- since old Tmp_Int is between [-(Base - 1) .. Base - 1]
799 -- and L_Vec is in [0 .. Base - 1] and Carry in [-1 .. 1]
801 if Tmp_Int >= Base then
802 Tmp_Int := Tmp_Int - Base;
805 elsif Tmp_Int <= -Base then
806 Tmp_Int := Tmp_Int + Base;
813 -- Tmp_Int is now between [-Base + 1 .. Base - 1]
818 Tmp_Int := Tmp_Int + Alt * Carry;
820 -- Tmp_Int is now between [-Base .. Base]
822 if Tmp_Int >= Base then
823 Tmp_Int := Tmp_Int - Base + Alt * Sign * 1;
825 elsif Tmp_Int <= -Base then
826 Tmp_Int := Tmp_Int + Base + Alt * Sign * (-1);
829 -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
836 -----------------------
837 -- Sum_Double_Digits --
838 -----------------------
840 -- Note: This is used in Rem, Base is assumed to be 2 ** 15
842 function Sum_Double_Digits (Left : Uint; Sign : Int) return Int is
844 -- First try simple case;
846 pragma Assert (Sign = Int_1 or Sign = Int (-1));
848 if Direct (Left) then
849 return Direct_Val (Left);
851 -- Otherwise full circuit is needed
855 L_Length : constant Int := N_Digits (Left);
856 L_Vec : UI_Vector (1 .. L_Length);
864 Init_Operand (Left, L_Vec);
865 L_Vec (1) := abs L_Vec (1);
873 Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry);
875 -- Least is in [-2 Base + 1 .. 2 * Base - 1]
876 -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
877 -- and old Least in [-Base + 1 .. Base - 1]
879 if Least_Sig_Int >= Base then
880 Least_Sig_Int := Least_Sig_Int - Base;
883 elsif Least_Sig_Int <= -Base then
884 Least_Sig_Int := Least_Sig_Int + Base;
891 -- Least is now in [-Base + 1 .. Base - 1]
893 Most_Sig_Int := Most_Sig_Int + Alt * (L_Vec (J - 1) + Carry);
895 -- Most is in [-2 Base + 1 .. 2 * Base - 1]
896 -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
897 -- and old Most in [-Base + 1 .. Base - 1]
899 if Most_Sig_Int >= Base then
900 Most_Sig_Int := Most_Sig_Int - Base;
903 elsif Most_Sig_Int <= -Base then
904 Most_Sig_Int := Most_Sig_Int + Base;
910 -- Most is now in [-Base + 1 .. Base - 1]
917 Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry);
919 Least_Sig_Int := Least_Sig_Int + Alt * Carry;
922 if Least_Sig_Int >= Base then
923 Least_Sig_Int := Least_Sig_Int - Base;
924 Most_Sig_Int := Most_Sig_Int + Alt * 1;
926 elsif Least_Sig_Int <= -Base then
927 Least_Sig_Int := Least_Sig_Int + Base;
928 Most_Sig_Int := Most_Sig_Int + Alt * (-1);
931 if Most_Sig_Int >= Base then
932 Most_Sig_Int := Most_Sig_Int - Base;
935 Least_Sig_Int + Alt * 1; -- cannot overflow again
937 elsif Most_Sig_Int <= -Base then
938 Most_Sig_Int := Most_Sig_Int + Base;
941 Least_Sig_Int + Alt * (-1); -- cannot overflow again.
944 return Most_Sig_Int * Base + Least_Sig_Int;
947 end Sum_Double_Digits;
953 procedure Tree_Read is
958 Tree_Read_Int (Int (Uint_Int_First));
959 Tree_Read_Int (Int (Uint_Int_Last));
960 Tree_Read_Int (UI_Power_2_Set);
961 Tree_Read_Int (UI_Power_10_Set);
962 Tree_Read_Int (Int (Uints_Min));
963 Tree_Read_Int (Udigits_Min);
965 for J in 0 .. UI_Power_2_Set loop
966 Tree_Read_Int (Int (UI_Power_2 (J)));
969 for J in 0 .. UI_Power_10_Set loop
970 Tree_Read_Int (Int (UI_Power_10 (J)));
979 procedure Tree_Write is
984 Tree_Write_Int (Int (Uint_Int_First));
985 Tree_Write_Int (Int (Uint_Int_Last));
986 Tree_Write_Int (UI_Power_2_Set);
987 Tree_Write_Int (UI_Power_10_Set);
988 Tree_Write_Int (Int (Uints_Min));
989 Tree_Write_Int (Udigits_Min);
991 for J in 0 .. UI_Power_2_Set loop
992 Tree_Write_Int (Int (UI_Power_2 (J)));
995 for J in 0 .. UI_Power_10_Set loop
996 Tree_Write_Int (Int (UI_Power_10 (J)));
1005 function UI_Abs (Right : Uint) return Uint is
1007 if Right < Uint_0 then
1018 function UI_Add (Left : Int; Right : Uint) return Uint is
1020 return UI_Add (UI_From_Int (Left), Right);
1023 function UI_Add (Left : Uint; Right : Int) return Uint is
1025 return UI_Add (Left, UI_From_Int (Right));
1028 function UI_Add (Left : Uint; Right : Uint) return Uint is
1030 -- Simple cases of direct operands and addition of zero
1032 if Direct (Left) then
1033 if Direct (Right) then
1034 return UI_From_Int (Direct_Val (Left) + Direct_Val (Right));
1036 elsif Int (Left) = Int (Uint_0) then
1040 elsif Direct (Right) and then Int (Right) = Int (Uint_0) then
1044 -- Otherwise full circuit is needed
1047 L_Length : constant Int := N_Digits (Left);
1048 R_Length : constant Int := N_Digits (Right);
1049 L_Vec : UI_Vector (1 .. L_Length);
1050 R_Vec : UI_Vector (1 .. R_Length);
1055 X_Bigger : Boolean := False;
1056 Y_Bigger : Boolean := False;
1057 Result_Neg : Boolean := False;
1060 Init_Operand (Left, L_Vec);
1061 Init_Operand (Right, R_Vec);
1063 -- At least one of the two operands is in multi-digit form.
1064 -- Calculate the number of digits sufficient to hold result.
1066 if L_Length > R_Length then
1067 Sum_Length := L_Length + 1;
1070 Sum_Length := R_Length + 1;
1071 if R_Length > L_Length then Y_Bigger := True; end if;
1074 -- Make copies of the absolute values of L_Vec and R_Vec into
1075 -- X and Y both with lengths equal to the maximum possibly
1076 -- needed. This makes looping over the digits much simpler.
1079 X : UI_Vector (1 .. Sum_Length);
1080 Y : UI_Vector (1 .. Sum_Length);
1081 Tmp_UI : UI_Vector (1 .. Sum_Length);
1084 for J in 1 .. Sum_Length - L_Length loop
1088 X (Sum_Length - L_Length + 1) := abs L_Vec (1);
1090 for J in 2 .. L_Length loop
1091 X (J + (Sum_Length - L_Length)) := L_Vec (J);
1094 for J in 1 .. Sum_Length - R_Length loop
1098 Y (Sum_Length - R_Length + 1) := abs R_Vec (1);
1100 for J in 2 .. R_Length loop
1101 Y (J + (Sum_Length - R_Length)) := R_Vec (J);
1104 if (L_Vec (1) < Int_0) = (R_Vec (1) < Int_0) then
1106 -- Same sign so just add
1109 for J in reverse 1 .. Sum_Length loop
1110 Tmp_Int := X (J) + Y (J) + Carry;
1112 if Tmp_Int >= Base then
1113 Tmp_Int := Tmp_Int - Base;
1122 return Vector_To_Uint (X, L_Vec (1) < Int_0);
1125 -- Find which one has bigger magnitude
1127 if not (X_Bigger or Y_Bigger) then
1128 for J in L_Vec'Range loop
1129 if abs L_Vec (J) > abs R_Vec (J) then
1132 elsif abs R_Vec (J) > abs L_Vec (J) then
1139 -- If they have identical magnitude, just return 0, else
1140 -- swap if necessary so that X had the bigger magnitude.
1141 -- Determine if result is negative at this time.
1143 Result_Neg := False;
1145 if not (X_Bigger or Y_Bigger) then
1149 if R_Vec (1) < Int_0 then
1158 if L_Vec (1) < Int_0 then
1163 -- Subtract Y from the bigger X
1167 for J in reverse 1 .. Sum_Length loop
1168 Tmp_Int := X (J) - Y (J) + Borrow;
1170 if Tmp_Int < Int_0 then
1171 Tmp_Int := Tmp_Int + Base;
1180 return Vector_To_Uint (X, Result_Neg);
1187 --------------------------
1188 -- UI_Decimal_Digits_Hi --
1189 --------------------------
1191 function UI_Decimal_Digits_Hi (U : Uint) return Nat is
1193 -- The maximum value of a "digit" is 32767, which is 5 decimal
1194 -- digits, so an N_Digit number could take up to 5 times this
1195 -- number of digits. This is certainly too high for large
1196 -- numbers but it is not worth worrying about.
1198 return 5 * N_Digits (U);
1199 end UI_Decimal_Digits_Hi;
1201 --------------------------
1202 -- UI_Decimal_Digits_Lo --
1203 --------------------------
1205 function UI_Decimal_Digits_Lo (U : Uint) return Nat is
1207 -- The maximum value of a "digit" is 32767, which is more than four
1208 -- decimal digits, but not a full five digits. The easily computed
1209 -- minimum number of decimal digits is thus 1 + 4 * the number of
1210 -- digits. This is certainly too low for large numbers but it is
1211 -- not worth worrying about.
1213 return 1 + 4 * (N_Digits (U) - 1);
1214 end UI_Decimal_Digits_Lo;
1220 function UI_Div (Left : Int; Right : Uint) return Uint is
1222 return UI_Div (UI_From_Int (Left), Right);
1225 function UI_Div (Left : Uint; Right : Int) return Uint is
1227 return UI_Div (Left, UI_From_Int (Right));
1230 function UI_Div (Left, Right : Uint) return Uint is
1232 pragma Assert (Right /= Uint_0);
1234 -- Cases where both operands are represented directly
1236 if Direct (Left) and then Direct (Right) then
1237 return UI_From_Int (Direct_Val (Left) / Direct_Val (Right));
1241 L_Length : constant Int := N_Digits (Left);
1242 R_Length : constant Int := N_Digits (Right);
1243 Q_Length : constant Int := L_Length - R_Length + 1;
1244 L_Vec : UI_Vector (1 .. L_Length);
1245 R_Vec : UI_Vector (1 .. R_Length);
1254 -- Result is zero if left operand is shorter than right
1256 if L_Length < R_Length then
1260 Init_Operand (Left, L_Vec);
1261 Init_Operand (Right, R_Vec);
1263 -- Case of right operand is single digit. Here we can simply divide
1264 -- each digit of the left operand by the divisor, from most to least
1265 -- significant, carrying the remainder to the next digit (just like
1266 -- ordinary long division by hand).
1268 if R_Length = Int_1 then
1270 Tmp_Divisor := abs R_Vec (1);
1273 Quotient : UI_Vector (1 .. L_Length);
1276 for J in L_Vec'Range loop
1277 Tmp_Int := Remainder * Base + abs L_Vec (J);
1278 Quotient (J) := Tmp_Int / Tmp_Divisor;
1279 Remainder := Tmp_Int rem Tmp_Divisor;
1284 (Quotient, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1288 -- The possible simple cases have been exhausted. Now turn to the
1289 -- algorithm D from the section of Knuth mentioned at the top of
1292 Algorithm_D : declare
1293 Dividend : UI_Vector (1 .. L_Length + 1);
1294 Divisor : UI_Vector (1 .. R_Length);
1295 Quotient : UI_Vector (1 .. Q_Length);
1301 -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1302 -- scale d, and then multiply Left and Right (u and v in the book)
1303 -- by d to get the dividend and divisor to work with.
1305 D := Base / (abs R_Vec (1) + 1);
1308 Dividend (2) := abs L_Vec (1);
1310 for J in 3 .. L_Length + Int_1 loop
1311 Dividend (J) := L_Vec (J - 1);
1314 Divisor (1) := abs R_Vec (1);
1316 for J in Int_2 .. R_Length loop
1317 Divisor (J) := R_Vec (J);
1322 -- Multiply Dividend by D
1325 for J in reverse Dividend'Range loop
1326 Tmp_Int := Dividend (J) * D + Carry;
1327 Dividend (J) := Tmp_Int rem Base;
1328 Carry := Tmp_Int / Base;
1331 -- Multiply Divisor by d.
1334 for J in reverse Divisor'Range loop
1335 Tmp_Int := Divisor (J) * D + Carry;
1336 Divisor (J) := Tmp_Int rem Base;
1337 Carry := Tmp_Int / Base;
1341 -- Main loop of long division algorithm.
1343 Divisor_Dig1 := Divisor (1);
1344 Divisor_Dig2 := Divisor (2);
1346 for J in Quotient'Range loop
1348 -- [ CALCULATE Q (hat) ] (step D3 in the algorithm).
1350 Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
1354 if Dividend (J) = Divisor_Dig1 then
1355 Q_Guess := Base - 1;
1357 Q_Guess := Tmp_Int / Divisor_Dig1;
1362 while Divisor_Dig2 * Q_Guess >
1363 (Tmp_Int - Q_Guess * Divisor_Dig1) * Base +
1366 Q_Guess := Q_Guess - 1;
1369 -- [ MULTIPLY & SUBTRACT] (step D4). Q_Guess * Divisor is
1370 -- subtracted from the remaining dividend.
1373 for K in reverse Divisor'Range loop
1374 Tmp_Int := Dividend (J + K) - Q_Guess * Divisor (K) + Carry;
1375 Tmp_Dig := Tmp_Int rem Base;
1376 Carry := Tmp_Int / Base;
1378 if Tmp_Dig < Int_0 then
1379 Tmp_Dig := Tmp_Dig + Base;
1383 Dividend (J + K) := Tmp_Dig;
1386 Dividend (J) := Dividend (J) + Carry;
1388 -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
1389 -- Here there is a slight difference from the book: the last
1390 -- carry is always added in above and below (cancelling each
1391 -- other). In fact the dividend going negative is used as
1394 -- If the Dividend went negative, then Q_Guess was off by
1395 -- one, so it is decremented, and the divisor is added back
1396 -- into the relevant portion of the dividend.
1398 if Dividend (J) < Int_0 then
1399 Q_Guess := Q_Guess - 1;
1402 for K in reverse Divisor'Range loop
1403 Tmp_Int := Dividend (J + K) + Divisor (K) + Carry;
1405 if Tmp_Int >= Base then
1406 Tmp_Int := Tmp_Int - Base;
1412 Dividend (J + K) := Tmp_Int;
1415 Dividend (J) := Dividend (J) + Carry;
1418 -- Finally we can get the next quotient digit
1420 Quotient (J) := Q_Guess;
1423 return Vector_To_Uint
1424 (Quotient, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1434 function UI_Eq (Left : Int; Right : Uint) return Boolean is
1436 return not UI_Ne (UI_From_Int (Left), Right);
1439 function UI_Eq (Left : Uint; Right : Int) return Boolean is
1441 return not UI_Ne (Left, UI_From_Int (Right));
1444 function UI_Eq (Left : Uint; Right : Uint) return Boolean is
1446 return not UI_Ne (Left, Right);
1453 function UI_Expon (Left : Int; Right : Uint) return Uint is
1455 return UI_Expon (UI_From_Int (Left), Right);
1458 function UI_Expon (Left : Uint; Right : Int) return Uint is
1460 return UI_Expon (Left, UI_From_Int (Right));
1463 function UI_Expon (Left : Int; Right : Int) return Uint is
1465 return UI_Expon (UI_From_Int (Left), UI_From_Int (Right));
1468 function UI_Expon (Left : Uint; Right : Uint) return Uint is
1470 pragma Assert (Right >= Uint_0);
1472 -- Any value raised to power of 0 is 1
1474 if Right = Uint_0 then
1477 -- 0 to any positive power is 0.
1479 elsif Left = Uint_0 then
1482 -- 1 to any power is 1
1484 elsif Left = Uint_1 then
1487 -- Any value raised to power of 1 is that value
1489 elsif Right = Uint_1 then
1492 -- Cases which can be done by table lookup
1494 elsif Right <= Uint_64 then
1496 -- 2 ** N for N in 2 .. 64
1498 if Left = Uint_2 then
1500 Right_Int : constant Int := Direct_Val (Right);
1503 if Right_Int > UI_Power_2_Set then
1504 for J in UI_Power_2_Set + Int_1 .. Right_Int loop
1505 UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2;
1506 Uints_Min := Uints.Last;
1507 Udigits_Min := Udigits.Last;
1510 UI_Power_2_Set := Right_Int;
1513 return UI_Power_2 (Right_Int);
1516 -- 10 ** N for N in 2 .. 64
1518 elsif Left = Uint_10 then
1520 Right_Int : constant Int := Direct_Val (Right);
1523 if Right_Int > UI_Power_10_Set then
1524 for J in UI_Power_10_Set + Int_1 .. Right_Int loop
1525 UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10);
1526 Uints_Min := Uints.Last;
1527 Udigits_Min := Udigits.Last;
1530 UI_Power_10_Set := Right_Int;
1533 return UI_Power_10 (Right_Int);
1538 -- If we fall through, then we have the general case (see Knuth 4.6.3)
1542 Squares : Uint := Left;
1543 Result : Uint := Uint_1;
1544 M : constant Uintp.Save_Mark := Uintp.Mark;
1548 if (Least_Sig_Digit (N) mod Int_2) = Int_1 then
1549 Result := Result * Squares;
1553 exit when N = Uint_0;
1554 Squares := Squares * Squares;
1557 Uintp.Release_And_Save (M, Result);
1566 function UI_From_CC (Input : Char_Code) return Uint is
1568 return UI_From_Dint (Dint (Input));
1575 function UI_From_Dint (Input : Dint) return Uint is
1578 if Dint (Min_Direct) <= Input and then Input <= Dint (Max_Direct) then
1579 return Uint (Dint (Uint_Direct_Bias) + Input);
1581 -- For values of larger magnitude, compute digits into a vector and
1582 -- call Vector_To_Uint.
1586 Max_For_Dint : constant := 5;
1587 -- Base is defined so that 5 Uint digits is sufficient
1588 -- to hold the largest possible Dint value.
1590 V : UI_Vector (1 .. Max_For_Dint);
1592 Temp_Integer : Dint;
1595 for J in V'Range loop
1599 Temp_Integer := Input;
1601 for J in reverse V'Range loop
1602 V (J) := Int (abs (Temp_Integer rem Dint (Base)));
1603 Temp_Integer := Temp_Integer / Dint (Base);
1606 return Vector_To_Uint (V, Input < Dint'(0));
1615 function UI_From_Int
(Input
: Int
) return Uint
is
1619 if Min_Direct
<= Input
and then Input
<= Max_Direct
then
1620 return Uint
(Int
(Uint_Direct_Bias
) + Input
);
1623 -- If already in the hash table, return entry
1625 U
:= UI_Ints
.Get
(Input
);
1627 if U
/= No_Uint
then
1631 -- For values of larger magnitude, compute digits into a vector and
1632 -- call Vector_To_Uint.
1635 Max_For_Int
: constant := 3;
1636 -- Base is defined so that 3 Uint digits is sufficient
1637 -- to hold the largest possible Int value.
1639 V
: UI_Vector
(1 .. Max_For_Int
);
1644 for J
in V
'Range loop
1648 Temp_Integer
:= Input
;
1650 for J
in reverse V
'Range loop
1651 V
(J
) := abs (Temp_Integer
rem Base
);
1652 Temp_Integer
:= Temp_Integer
/ Base
;
1655 U
:= Vector_To_Uint
(V
, Input
< Int_0
);
1656 UI_Ints
.Set
(Input
, U
);
1657 Uints_Min
:= Uints
.Last
;
1658 Udigits_Min
:= Udigits
.Last
;
1667 -- Lehmer's algorithm for GCD.
1669 -- The idea is to avoid using multiple precision arithmetic wherever
1670 -- possible, substituting Int arithmetic instead. See Knuth volume II,
1671 -- Algorithm L (page 329).
1673 -- We use the same notation as Knuth (U_Hat standing for the obvious!)
1675 function UI_GCD
(Uin
, Vin
: Uint
) return Uint
is
1677 -- Copies of Uin and Vin
1680 -- The most Significant digits of U,V
1682 A
, B
, C
, D
, T
, Q
, Den1
, Den2
: Int
;
1685 Marks
: constant Uintp
.Save_Mark
:= Uintp
.Mark
;
1686 Iterations
: Integer := 0;
1689 pragma Assert
(Uin
>= Vin
);
1690 pragma Assert
(Vin
>= Uint_0
);
1696 Iterations
:= Iterations
+ 1;
1703 UI_From_Int
(GCD
(Direct_Val
(V
), UI_To_Int
(U
rem V
)));
1707 Most_Sig_2_Digits
(U
, V
, U_Hat
, V_Hat
);
1714 -- We might overflow and get division by zero here. This just
1715 -- means we can not take the single precision step
1719 exit when (Den1
* Den2
) = Int_0
;
1721 -- Compute Q, the trial quotient
1723 Q
:= (U_Hat
+ A
) / Den1
;
1725 exit when Q
/= ((U_Hat
+ B
) / Den2
);
1727 -- A single precision step Euclid step will give same answer as
1728 -- a multiprecision one.
1738 T
:= U_Hat
- (Q
* V_Hat
);
1744 -- Take a multiprecision Euclid step
1748 -- No single precision steps take a regular Euclid step.
1755 -- Use prior single precision steps to compute this Euclid step.
1757 -- Fixed bug 1415-008 spends 80% of its time working on this
1758 -- step. Perhaps we need a special case Int / Uint dot
1759 -- product to speed things up. ???
1761 -- Alternatively we could increase the single precision
1762 -- iterations to handle Uint's of some small size ( <5
1763 -- digits?). Then we would have more iterations on small Uint.
1764 -- Fixed bug 1415-008 only gets 5 (on average) single
1765 -- precision iterations per large iteration. ???
1767 Tmp_UI
:= (UI_From_Int
(A
) * U
) + (UI_From_Int
(B
) * V
);
1768 V
:= (UI_From_Int
(C
) * U
) + (UI_From_Int
(D
) * V
);
1772 -- If the operands are very different in magnitude, the loop
1773 -- will generate large amounts of short-lived data, which it is
1774 -- worth removing periodically.
1776 if Iterations
> 100 then
1777 Release_And_Save
(Marks
, U
, V
);
1787 function UI_Ge
(Left
: Int
; Right
: Uint
) return Boolean is
1789 return not UI_Lt
(UI_From_Int
(Left
), Right
);
1792 function UI_Ge
(Left
: Uint
; Right
: Int
) return Boolean is
1794 return not UI_Lt
(Left
, UI_From_Int
(Right
));
1797 function UI_Ge
(Left
: Uint
; Right
: Uint
) return Boolean is
1799 return not UI_Lt
(Left
, Right
);
1806 function UI_Gt
(Left
: Int
; Right
: Uint
) return Boolean is
1808 return UI_Lt
(Right
, UI_From_Int
(Left
));
1811 function UI_Gt
(Left
: Uint
; Right
: Int
) return Boolean is
1813 return UI_Lt
(UI_From_Int
(Right
), Left
);
1816 function UI_Gt
(Left
: Uint
; Right
: Uint
) return Boolean is
1818 return UI_Lt
(Right
, Left
);
1825 procedure UI_Image
(Input
: Uint
; Format
: UI_Format
:= Auto
) is
1827 Image_Out
(Input
, True, Format
);
1830 -------------------------
1831 -- UI_Is_In_Int_Range --
1832 -------------------------
1834 function UI_Is_In_Int_Range
(Input
: Uint
) return Boolean is
1836 -- Make sure we don't get called before Initialize
1838 pragma Assert
(Uint_Int_First
/= Uint_0
);
1840 if Direct
(Input
) then
1843 return Input
>= Uint_Int_First
1844 and then Input
<= Uint_Int_Last
;
1846 end UI_Is_In_Int_Range
;
1852 function UI_Le
(Left
: Int
; Right
: Uint
) return Boolean is
1854 return not UI_Lt
(Right
, UI_From_Int
(Left
));
1857 function UI_Le
(Left
: Uint
; Right
: Int
) return Boolean is
1859 return not UI_Lt
(UI_From_Int
(Right
), Left
);
1862 function UI_Le
(Left
: Uint
; Right
: Uint
) return Boolean is
1864 return not UI_Lt
(Right
, Left
);
1871 function UI_Lt
(Left
: Int
; Right
: Uint
) return Boolean is
1873 return UI_Lt
(UI_From_Int
(Left
), Right
);
1876 function UI_Lt
(Left
: Uint
; Right
: Int
) return Boolean is
1878 return UI_Lt
(Left
, UI_From_Int
(Right
));
1881 function UI_Lt
(Left
: Uint
; Right
: Uint
) return Boolean is
1883 -- Quick processing for identical arguments
1885 if Int
(Left
) = Int
(Right
) then
1888 -- Quick processing for both arguments directly represented
1890 elsif Direct
(Left
) and then Direct
(Right
) then
1891 return Int
(Left
) < Int
(Right
);
1893 -- At least one argument is more than one digit long
1897 L_Length
: constant Int
:= N_Digits
(Left
);
1898 R_Length
: constant Int
:= N_Digits
(Right
);
1900 L_Vec
: UI_Vector
(1 .. L_Length
);
1901 R_Vec
: UI_Vector
(1 .. R_Length
);
1904 Init_Operand
(Left
, L_Vec
);
1905 Init_Operand
(Right
, R_Vec
);
1907 if L_Vec
(1) < Int_0
then
1909 -- First argument negative, second argument non-negative
1911 if R_Vec
(1) >= Int_0
then
1914 -- Both arguments negative
1917 if L_Length
/= R_Length
then
1918 return L_Length
> R_Length
;
1920 elsif L_Vec
(1) /= R_Vec
(1) then
1921 return L_Vec
(1) < R_Vec
(1);
1924 for J
in 2 .. L_Vec
'Last loop
1925 if L_Vec
(J
) /= R_Vec
(J
) then
1926 return L_Vec
(J
) > R_Vec
(J
);
1935 -- First argument non-negative, second argument negative
1937 if R_Vec
(1) < Int_0
then
1940 -- Both arguments non-negative
1943 if L_Length
/= R_Length
then
1944 return L_Length
< R_Length
;
1946 for J
in L_Vec
'Range loop
1947 if L_Vec
(J
) /= R_Vec
(J
) then
1948 return L_Vec
(J
) < R_Vec
(J
);
1964 function UI_Max
(Left
: Int
; Right
: Uint
) return Uint
is
1966 return UI_Max
(UI_From_Int
(Left
), Right
);
1969 function UI_Max
(Left
: Uint
; Right
: Int
) return Uint
is
1971 return UI_Max
(Left
, UI_From_Int
(Right
));
1974 function UI_Max
(Left
: Uint
; Right
: Uint
) return Uint
is
1976 if Left
>= Right
then
1987 function UI_Min
(Left
: Int
; Right
: Uint
) return Uint
is
1989 return UI_Min
(UI_From_Int
(Left
), Right
);
1992 function UI_Min
(Left
: Uint
; Right
: Int
) return Uint
is
1994 return UI_Min
(Left
, UI_From_Int
(Right
));
1997 function UI_Min
(Left
: Uint
; Right
: Uint
) return Uint
is
1999 if Left
<= Right
then
2010 function UI_Mod
(Left
: Int
; Right
: Uint
) return Uint
is
2012 return UI_Mod
(UI_From_Int
(Left
), Right
);
2015 function UI_Mod
(Left
: Uint
; Right
: Int
) return Uint
is
2017 return UI_Mod
(Left
, UI_From_Int
(Right
));
2020 function UI_Mod
(Left
: Uint
; Right
: Uint
) return Uint
is
2021 Urem
: constant Uint
:= Left
rem Right
;
2024 if (Left
< Uint_0
) = (Right
< Uint_0
)
2025 or else Urem
= Uint_0
2029 return Right
+ Urem
;
2037 function UI_Mul
(Left
: Int
; Right
: Uint
) return Uint
is
2039 return UI_Mul
(UI_From_Int
(Left
), Right
);
2042 function UI_Mul
(Left
: Uint
; Right
: Int
) return Uint
is
2044 return UI_Mul
(Left
, UI_From_Int
(Right
));
2047 function UI_Mul
(Left
: Uint
; Right
: Uint
) return Uint
is
2049 -- Simple case of single length operands
2051 if Direct
(Left
) and then Direct
(Right
) then
2054 (Dint
(Direct_Val
(Left
)) * Dint
(Direct_Val
(Right
)));
2057 -- Otherwise we have the general case (Algorithm M in Knuth)
2060 L_Length
: constant Int
:= N_Digits
(Left
);
2061 R_Length
: constant Int
:= N_Digits
(Right
);
2062 L_Vec
: UI_Vector
(1 .. L_Length
);
2063 R_Vec
: UI_Vector
(1 .. R_Length
);
2067 Init_Operand
(Left
, L_Vec
);
2068 Init_Operand
(Right
, R_Vec
);
2069 Neg
:= (L_Vec
(1) < Int_0
) xor (R_Vec
(1) < Int_0
);
2070 L_Vec
(1) := abs (L_Vec
(1));
2071 R_Vec
(1) := abs (R_Vec
(1));
2073 Algorithm_M
: declare
2074 Product
: UI_Vector
(1 .. L_Length
+ R_Length
);
2079 for J
in Product
'Range loop
2083 for J
in reverse R_Vec
'Range loop
2085 for K
in reverse L_Vec
'Range loop
2087 L_Vec
(K
) * R_Vec
(J
) + Product
(J
+ K
) + Carry
;
2088 Product
(J
+ K
) := Tmp_Sum
rem Base
;
2089 Carry
:= Tmp_Sum
/ Base
;
2092 Product
(J
) := Carry
;
2095 return Vector_To_Uint
(Product
, Neg
);
2104 function UI_Ne
(Left
: Int
; Right
: Uint
) return Boolean is
2106 return UI_Ne
(UI_From_Int
(Left
), Right
);
2109 function UI_Ne
(Left
: Uint
; Right
: Int
) return Boolean is
2111 return UI_Ne
(Left
, UI_From_Int
(Right
));
2114 function UI_Ne
(Left
: Uint
; Right
: Uint
) return Boolean is
2116 -- Quick processing for identical arguments. Note that this takes
2117 -- care of the case of two No_Uint arguments.
2119 if Int
(Left
) = Int
(Right
) then
2123 -- See if left operand directly represented
2125 if Direct
(Left
) then
2127 -- If right operand directly represented then compare
2129 if Direct
(Right
) then
2130 return Int
(Left
) /= Int
(Right
);
2132 -- Left operand directly represented, right not, must be unequal
2138 -- Right operand directly represented, left not, must be unequal
2140 elsif Direct
(Right
) then
2144 -- Otherwise both multi-word, do comparison
2147 Size
: constant Int
:= N_Digits
(Left
);
2152 if Size
/= N_Digits
(Right
) then
2156 Left_Loc
:= Uints
.Table
(Left
).Loc
;
2157 Right_Loc
:= Uints
.Table
(Right
).Loc
;
2159 for J
in Int_0
.. Size
- Int_1
loop
2160 if Udigits
.Table
(Left_Loc
+ J
) /=
2161 Udigits
.Table
(Right_Loc
+ J
)
2175 function UI_Negate
(Right
: Uint
) return Uint
is
2177 -- Case where input is directly represented. Note that since the
2178 -- range of Direct values is non-symmetrical, the result may not
2179 -- be directly represented, this is taken care of in UI_From_Int.
2181 if Direct
(Right
) then
2182 return UI_From_Int
(-Direct_Val
(Right
));
2184 -- Full processing for multi-digit case. Note that we cannot just
2185 -- copy the value to the end of the table negating the first digit,
2186 -- since the range of Direct values is non-symmetrical, so we can
2187 -- have a negative value that is not Direct whose negation can be
2188 -- represented directly.
2192 R_Length
: constant Int
:= N_Digits
(Right
);
2193 R_Vec
: UI_Vector
(1 .. R_Length
);
2197 Init_Operand
(Right
, R_Vec
);
2198 Neg
:= R_Vec
(1) > Int_0
;
2199 R_Vec
(1) := abs R_Vec
(1);
2200 return Vector_To_Uint
(R_Vec
, Neg
);
2209 function UI_Rem
(Left
: Int
; Right
: Uint
) return Uint
is
2211 return UI_Rem
(UI_From_Int
(Left
), Right
);
2214 function UI_Rem
(Left
: Uint
; Right
: Int
) return Uint
is
2216 return UI_Rem
(Left
, UI_From_Int
(Right
));
2219 function UI_Rem
(Left
, Right
: Uint
) return Uint
is
2223 subtype Int1_12
is Integer range 1 .. 12;
2226 pragma Assert
(Right
/= Uint_0
);
2228 if Direct
(Right
) then
2229 if Direct
(Left
) then
2230 return UI_From_Int
(Direct_Val
(Left
) rem Direct_Val
(Right
));
2233 -- Special cases when Right is less than 13 and Left is larger
2234 -- larger than one digit. All of these algorithms depend on the
2235 -- base being 2 ** 15 We work with Abs (Left) and Abs(Right)
2236 -- then multiply result by Sign (Left)
2238 if (Right
<= Uint_12
) and then (Right
>= Uint_Minus_12
) then
2240 if Left
< Uint_0
then
2246 -- All cases are listed, grouped by mathematical method
2247 -- It is not inefficient to do have this case list out
2248 -- of order since GCC sorts the cases we list.
2250 case Int1_12
(abs (Direct_Val
(Right
))) is
2255 -- Powers of two are simple AND's with LS Left Digit
2256 -- GCC will recognise these constants as powers of 2
2257 -- and replace the rem with simpler operations where
2260 -- Least_Sig_Digit might return Negative numbers.
2263 return UI_From_Int
(
2264 Sign
* (Least_Sig_Digit
(Left
) mod 2));
2267 return UI_From_Int
(
2268 Sign
* (Least_Sig_Digit
(Left
) mod 4));
2271 return UI_From_Int
(
2272 Sign
* (Least_Sig_Digit
(Left
) mod 8));
2274 -- Some number theoretical tricks:
2276 -- If B Rem Right = 1 then
2277 -- Left Rem Right = Sum_Of_Digits_Base_B (Left) Rem Right
2279 -- Note: 2^32 mod 3 = 1
2282 return UI_From_Int
(
2283 Sign
* (Sum_Double_Digits
(Left
, 1) rem Int
(3)));
2285 -- Note: 2^15 mod 7 = 1
2288 return UI_From_Int
(
2289 Sign
* (Sum_Digits
(Left
, 1) rem Int
(7)));
2291 -- Note: 2^32 mod 5 = -1
2292 -- Alternating sums might be negative, but rem is always
2293 -- positive hence we must use mod here.
2296 Tmp
:= Sum_Double_Digits
(Left
, -1) mod Int
(5);
2297 return UI_From_Int
(Sign
* Tmp
);
2299 -- Note: 2^15 mod 9 = -1
2300 -- Alternating sums might be negative, but rem is always
2301 -- positive hence we must use mod here.
2304 Tmp
:= Sum_Digits
(Left
, -1) mod Int
(9);
2305 return UI_From_Int
(Sign
* Tmp
);
2307 -- Note: 2^15 mod 11 = -1
2308 -- Alternating sums might be negative, but rem is always
2309 -- positive hence we must use mod here.
2312 Tmp
:= Sum_Digits
(Left
, -1) mod Int
(11);
2313 return UI_From_Int
(Sign
* Tmp
);
2315 -- Now resort to Chinese Remainder theorem
2316 -- to reduce 6, 10, 12 to previous special cases
2318 -- There is no reason we could not add more cases
2319 -- like these if it proves useful.
2321 -- Perhaps we should go up to 16, however
2322 -- I have no "trick" for 13.
2324 -- To find u mod m we:
2326 -- GCD(m1, m2) = 1 AND m = (m1 * m2).
2327 -- Next we pick (Basis) M1, M2 small S.T.
2328 -- (M1 mod m1) = (M2 mod m2) = 1 AND
2329 -- (M1 mod m2) = (M2 mod m1) = 0
2331 -- So u mod m = (u1 * M1 + u2 * M2) mod m
2332 -- Where u1 = (u mod m1) AND u2 = (u mod m2);
2333 -- Under typical circumstances the last mod m
2334 -- can be done with a (possible) single subtraction.
2336 -- m1 = 2; m2 = 3; M1 = 3; M2 = 4;
2339 Tmp
:= 3 * (Least_Sig_Digit
(Left
) rem 2) +
2340 4 * (Sum_Double_Digits
(Left
, 1) rem 3);
2341 return UI_From_Int
(Sign
* (Tmp
rem 6));
2343 -- m1 = 2; m2 = 5; M1 = 5; M2 = 6;
2346 Tmp
:= 5 * (Least_Sig_Digit
(Left
) rem 2) +
2347 6 * (Sum_Double_Digits
(Left
, -1) mod 5);
2348 return UI_From_Int
(Sign
* (Tmp
rem 10));
2350 -- m1 = 3; m2 = 4; M1 = 4; M2 = 9;
2353 Tmp
:= 4 * (Sum_Double_Digits
(Left
, 1) rem 3) +
2354 9 * (Least_Sig_Digit
(Left
) rem 4);
2355 return UI_From_Int
(Sign
* (Tmp
rem 12));
2360 -- Else fall through to general case.
2362 -- ???This needs to be improved. We have the Rem when we do the
2363 -- Div. Div throws it away!
2365 -- The special case Length (Left) = Length(right) = 1 in Div
2366 -- looks slow. It uses UI_To_Int when Int should suffice. ???
2370 return Left
- (Left
/ Right
) * Right
;
2377 function UI_Sub
(Left
: Int
; Right
: Uint
) return Uint
is
2379 return UI_Add
(Left
, -Right
);
2382 function UI_Sub
(Left
: Uint
; Right
: Int
) return Uint
is
2384 return UI_Add
(Left
, -Right
);
2387 function UI_Sub
(Left
: Uint
; Right
: Uint
) return Uint
is
2389 if Direct
(Left
) and then Direct
(Right
) then
2390 return UI_From_Int
(Direct_Val
(Left
) - Direct_Val
(Right
));
2392 return UI_Add
(Left
, -Right
);
2400 function UI_To_CC
(Input
: Uint
) return Char_Code
is
2402 if Direct
(Input
) then
2403 return Char_Code
(Direct_Val
(Input
));
2405 -- Case of input is more than one digit
2409 In_Length
: constant Int
:= N_Digits
(Input
);
2410 In_Vec
: UI_Vector
(1 .. In_Length
);
2414 Init_Operand
(Input
, In_Vec
);
2416 -- We assume value is positive
2419 for Idx
in In_Vec
'Range loop
2420 Ret_CC
:= Ret_CC
* Char_Code
(Base
) +
2421 Char_Code
(abs In_Vec
(Idx
));
2433 function UI_To_Int
(Input
: Uint
) return Int
is
2435 if Direct
(Input
) then
2436 return Direct_Val
(Input
);
2438 -- Case of input is more than one digit
2442 In_Length
: constant Int
:= N_Digits
(Input
);
2443 In_Vec
: UI_Vector
(1 .. In_Length
);
2447 -- Uints of more than one digit could be outside the range for
2448 -- Ints. Caller should have checked for this if not certain.
2449 -- Fatal error to attempt to convert from value outside Int'Range.
2451 pragma Assert
(UI_Is_In_Int_Range
(Input
));
2453 -- Otherwise, proceed ahead, we are OK
2455 Init_Operand
(Input
, In_Vec
);
2458 -- Calculate -|Input| and then negates if value is positive.
2459 -- This handles our current definition of Int (based on
2460 -- 2s complement). Is it secure enough?
2462 for Idx
in In_Vec
'Range loop
2463 Ret_Int
:= Ret_Int
* Base
- abs In_Vec
(Idx
);
2466 if In_Vec
(1) < Int_0
then
2479 procedure UI_Write
(Input
: Uint
; Format
: UI_Format
:= Auto
) is
2481 Image_Out
(Input
, False, Format
);
2484 ---------------------
2485 -- Vector_To_Uint --
2486 ---------------------
2488 function Vector_To_Uint
2489 (In_Vec
: UI_Vector
;
2497 -- The vector can contain leading zeros. These are not stored in the
2498 -- table, so loop through the vector looking for first non-zero digit
2500 for J
in In_Vec
'Range loop
2501 if In_Vec
(J
) /= Int_0
then
2503 -- The length of the value is the length of the rest of the vector
2505 Size
:= In_Vec
'Last - J
+ 1;
2507 -- One digit value can always be represented directly
2509 if Size
= Int_1
then
2511 return Uint
(Int
(Uint_Direct_Bias
) - In_Vec
(J
));
2513 return Uint
(Int
(Uint_Direct_Bias
) + In_Vec
(J
));
2516 -- Positive two digit values may be in direct representation range
2518 elsif Size
= Int_2
and then not Negative
then
2519 Val
:= In_Vec
(J
) * Base
+ In_Vec
(J
+ 1);
2521 if Val
<= Max_Direct
then
2522 return Uint
(Int
(Uint_Direct_Bias
) + Val
);
2526 -- The value is outside the direct representation range and
2527 -- must therefore be stored in the table. Expand the table
2528 -- to contain the count and tigis. The index of the new table
2529 -- entry will be returned as the result.
2531 Uints
.Increment_Last
;
2532 Uints
.Table
(Uints
.Last
).Length
:= Size
;
2533 Uints
.Table
(Uints
.Last
).Loc
:= Udigits
.Last
+ 1;
2535 Udigits
.Increment_Last
;
2538 Udigits
.Table
(Udigits
.Last
) := -In_Vec
(J
);
2540 Udigits
.Table
(Udigits
.Last
) := +In_Vec
(J
);
2543 for K
in 2 .. Size
loop
2544 Udigits
.Increment_Last
;
2545 Udigits
.Table
(Udigits
.Last
) := In_Vec
(J
+ K
- 1);
2552 -- Dropped through loop only if vector contained all zeros