| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- U I N T P -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Output; use Output; |
| |
| with GNAT.HTable; use GNAT.HTable; |
| |
| package body Uintp is |
| |
| ------------------------ |
| -- Local Declarations -- |
| ------------------------ |
| |
| Uint_Int_First : Uint := Uint_0; |
| -- Uint value containing Int'First value, set by Initialize. The initial |
| -- value of Uint_0 is used for an assertion check that ensures that this |
| -- value is not used before it is initialized. This value is used in the |
| -- UI_Is_In_Int_Range predicate, and it is right that this is a host value, |
| -- since the issue is host representation of integer values. |
| |
| Uint_Int_Last : Uint; |
| -- Uint value containing Int'Last value set by Initialize |
| |
| UI_Power_2 : array (Int range 0 .. 128) of Uint; |
| -- This table is used to memoize exponentiations by powers of 2. The Nth |
| -- entry, if set, contains the Uint value 2**N. Initially UI_Power_2_Set |
| -- is zero and only the 0'th entry is set, the invariant being that all |
| -- entries in the range 0 .. UI_Power_2_Set are initialized. |
| |
| UI_Power_2_Set : Nat; |
| -- Number of entries set in UI_Power_2; |
| |
| UI_Power_10 : array (Int range 0 .. 128) of Uint; |
| -- This table is used to memoize exponentiations by powers of 10 in the |
| -- same manner as described above for UI_Power_2. |
| |
| UI_Power_10_Set : Nat; |
| -- Number of entries set in UI_Power_10; |
| |
| Uints_Min : Uint; |
| Udigits_Min : Int; |
| -- These values are used to make sure that the mark/release mechanism does |
| -- not destroy values saved in the U_Power tables or in the hash table used |
| -- by UI_From_Int. Whenever an entry is made in either of these tables, |
| -- Uints_Min and Udigits_Min are updated to protect the entry, and Release |
| -- never cuts back beyond these minimum values. |
| |
| Int_0 : constant Int := 0; |
| Int_1 : constant Int := 1; |
| Int_2 : constant Int := 2; |
| -- These values are used in some cases where the use of numeric literals |
| -- would cause ambiguities (integer vs Uint). |
| |
| type UI_Vector is array (Pos range <>) of Int; |
| -- Vector containing the integer values of a Uint value |
| |
| -- Note: An earlier version of this package used pointers of arrays of Ints |
| -- (dynamically allocated) for the Uint type. The change leads to a few |
| -- less natural idioms used throughout this code, but eliminates all uses |
| -- of the heap except for the table package itself. For example, Uint |
| -- parameters are often converted to UI_Vectors for internal manipulation. |
| -- This is done by creating the local UI_Vector using the function N_Digits |
| -- on the Uint to find the size needed for the vector, and then calling |
| -- Init_Operand to copy the values out of the table into the vector. |
| |
| ---------------------------- |
| -- UI_From_Int Hash Table -- |
| ---------------------------- |
| |
| -- UI_From_Int uses a hash table to avoid duplicating entries and wasting |
| -- storage. This is particularly important for complex cases of back |
| -- annotation. |
| |
| subtype Hnum is Nat range 0 .. 1022; |
| |
| function Hash_Num (F : Int) return Hnum; |
| -- Hashing function |
| |
| package UI_Ints is new Simple_HTable ( |
| Header_Num => Hnum, |
| Element => Uint, |
| No_Element => No_Uint, |
| Key => Int, |
| Hash => Hash_Num, |
| Equal => "="); |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| function Direct (U : Valid_Uint) return Boolean; |
| pragma Inline (Direct); |
| -- Returns True if U is represented directly |
| |
| function Direct_Val (U : Valid_Uint) return Int; |
| -- U is a Uint that is represented directly. The returned result is the |
| -- value represented. |
| |
| function GCD (Jin, Kin : Int) return Int; |
| -- Compute GCD of two integers. Assumes that Jin >= Kin >= 0 |
| |
| procedure Image_Out |
| (Input : Uint; |
| To_Buffer : Boolean; |
| Format : UI_Format); |
| -- Common processing for UI_Image and UI_Write, To_Buffer is set True for |
| -- UI_Image, and false for UI_Write, and Format is copied from the Format |
| -- parameter to UI_Image or UI_Write. |
| |
| procedure Init_Operand (UI : Valid_Uint; Vec : out UI_Vector); |
| pragma Inline (Init_Operand); |
| -- This procedure puts the value of UI into the vector in canonical |
| -- multiple precision format. The parameter should be of the correct size |
| -- as determined by a previous call to N_Digits (UI). The first digit of |
| -- Vec contains the sign, all other digits are always non-negative. Note |
| -- that the input may be directly represented, and in this case Vec will |
| -- contain the corresponding one or two digit value. The low bound of Vec |
| -- is always 1. |
| |
| function Vector_To_Uint |
| (In_Vec : UI_Vector; |
| Negative : Boolean) return Valid_Uint; |
| -- Functions that calculate values in UI_Vectors, call this function to |
| -- create and return the Uint value. In_Vec contains the multiple precision |
| -- (Base) representation of a non-negative value. Leading zeroes are |
| -- permitted. Negative is set if the desired result is the negative of the |
| -- given value. The result will be either the appropriate directly |
| -- represented value, or a table entry in the proper canonical format is |
| -- created and returned. |
| -- |
| -- Note that Init_Operand puts a signed value in the result vector, but |
| -- Vector_To_Uint is always presented with a non-negative value. The |
| -- processing of signs is something that is done by the caller before |
| -- calling Vector_To_Uint. |
| |
| function Least_Sig_Digit (Arg : Valid_Uint) return Int; |
| pragma Inline (Least_Sig_Digit); |
| -- Returns the Least Significant Digit of Arg quickly. When the given Uint |
| -- is less than 2**15, the value returned is the input value, in this case |
| -- the result may be negative. It is expected that any use will mask off |
| -- unnecessary bits. This is used for finding Arg mod B where B is a power |
| -- of two. Hence the actual base is irrelevant as long as it is a power of |
| -- two. |
| |
| procedure Most_Sig_2_Digits |
| (Left : Valid_Uint; |
| Right : Valid_Uint; |
| Left_Hat : out Int; |
| Right_Hat : out Int); |
| -- Returns leading two significant digits from the given pair of Uint's. |
| -- Mathematically: returns Left / (Base**K) and Right / (Base**K) where |
| -- K is as small as possible S.T. Right_Hat < Base * Base. It is required |
| -- that Left >= Right for the algorithm to work. |
| |
| function N_Digits (Input : Valid_Uint) return Int; |
| pragma Inline (N_Digits); |
| -- Returns number of "digits" in a Uint |
| |
| procedure UI_Div_Rem |
| (Left, Right : Valid_Uint; |
| Quotient : out Uint; |
| Remainder : out Uint; |
| Discard_Quotient : Boolean := False; |
| Discard_Remainder : Boolean := False); |
| -- Compute Euclidean division of Left by Right. If Discard_Quotient is |
| -- False then the quotient is returned in Quotient. If Discard_Remainder |
| -- is False, then the remainder is returned in Remainder. |
| -- |
| -- If Discard_Quotient is True, Quotient is set to No_Uint. |
| -- If Discard_Remainder is True, Remainder is set to No_Uint. |
| |
| function UI_Modular_Exponentiation |
| (B : Valid_Uint; |
| E : Valid_Uint; |
| Modulo : Valid_Uint) return Valid_Uint with Unreferenced; |
| -- Efficiently compute (B**E) rem Modulo |
| |
| function UI_Modular_Inverse |
| (N : Valid_Uint; Modulo : Valid_Uint) return Valid_Uint with Unreferenced; |
| -- Compute the multiplicative inverse of N in modular arithmetics with the |
| -- given Modulo (uses Euclid's algorithm). Note: the call is considered |
| -- to be erroneous (and the behavior is undefined) if n is not invertible. |
| |
| ------------ |
| -- Direct -- |
| ------------ |
| |
| function Direct (U : Valid_Uint) return Boolean is |
| begin |
| return Int (U) <= Int (Uint_Direct_Last); |
| end Direct; |
| |
| ---------------- |
| -- Direct_Val -- |
| ---------------- |
| |
| function Direct_Val (U : Valid_Uint) return Int is |
| begin |
| pragma Assert (Direct (U)); |
| return Int (U) - Int (Uint_Direct_Bias); |
| end Direct_Val; |
| |
| --------- |
| -- GCD -- |
| --------- |
| |
| function GCD (Jin, Kin : Int) return Int is |
| J, K, Tmp : Int; |
| |
| begin |
| pragma Assert (Jin >= Kin); |
| pragma Assert (Kin >= Int_0); |
| |
| J := Jin; |
| K := Kin; |
| while K /= Uint_0 loop |
| Tmp := J mod K; |
| J := K; |
| K := Tmp; |
| end loop; |
| |
| return J; |
| end GCD; |
| |
| -------------- |
| -- Hash_Num -- |
| -------------- |
| |
| function Hash_Num (F : Int) return Hnum is |
| begin |
| return Types."mod" (F, Hnum'Range_Length); |
| end Hash_Num; |
| |
| --------------- |
| -- Image_Out -- |
| --------------- |
| |
| procedure Image_Out |
| (Input : Uint; |
| To_Buffer : Boolean; |
| Format : UI_Format) |
| is |
| Marks : constant Uintp.Save_Mark := Uintp.Mark; |
| Base : Valid_Uint; |
| Ainput : Valid_Uint; |
| |
| Digs_Output : Natural := 0; |
| -- Counts digits output. In hex mode, but not in decimal mode, we |
| -- put an underline after every four hex digits that are output. |
| |
| Exponent : Natural := 0; |
| -- If the number is too long to fit in the buffer, we switch to an |
| -- approximate output format with an exponent. This variable records |
| -- the exponent value. |
| |
| function Better_In_Hex return Boolean; |
| -- Determines if it is better to generate digits in base 16 (result |
| -- is true) or base 10 (result is false). The choice is purely a |
| -- matter of convenience and aesthetics, so it does not matter which |
| -- value is returned from a correctness point of view. |
| |
| procedure Image_Char (C : Character); |
| -- Output one character |
| |
| procedure Image_String (S : String); |
| -- Output characters |
| |
| procedure Image_Exponent (N : Natural); |
| -- Output non-zero exponent. Note that we only use the exponent form in |
| -- the buffer case, so we know that To_Buffer is true. |
| |
| procedure Image_Uint (U : Valid_Uint); |
| -- Internal procedure to output characters of non-negative Uint |
| |
| ------------------- |
| -- Better_In_Hex -- |
| ------------------- |
| |
| function Better_In_Hex return Boolean is |
| T16 : constant Valid_Uint := Uint_2**Int'(16); |
| A : Valid_Uint; |
| |
| begin |
| A := UI_Abs (Input); |
| |
| -- Small values up to 2**16 can always be in decimal |
| |
| if A < T16 then |
| return False; |
| end if; |
| |
| -- Otherwise, see if we are a power of 2 or one less than a power |
| -- of 2. For the moment these are the only cases printed in hex. |
| |
| if A mod Uint_2 = Uint_1 then |
| A := A + Uint_1; |
| end if; |
| |
| loop |
| if A mod T16 /= Uint_0 then |
| return False; |
| |
| else |
| A := A / T16; |
| end if; |
| |
| exit when A < T16; |
| end loop; |
| |
| while A > Uint_2 loop |
| if A mod Uint_2 /= Uint_0 then |
| return False; |
| |
| else |
| A := A / Uint_2; |
| end if; |
| end loop; |
| |
| return True; |
| end Better_In_Hex; |
| |
| ---------------- |
| -- Image_Char -- |
| ---------------- |
| |
| procedure Image_Char (C : Character) is |
| begin |
| if To_Buffer then |
| if UI_Image_Length + 6 > UI_Image_Max then |
| Exponent := Exponent + 1; |
| else |
| UI_Image_Length := UI_Image_Length + 1; |
| UI_Image_Buffer (UI_Image_Length) := C; |
| end if; |
| else |
| Write_Char (C); |
| end if; |
| end Image_Char; |
| |
| -------------------- |
| -- Image_Exponent -- |
| -------------------- |
| |
| procedure Image_Exponent (N : Natural) is |
| begin |
| if N >= 10 then |
| Image_Exponent (N / 10); |
| end if; |
| |
| UI_Image_Length := UI_Image_Length + 1; |
| UI_Image_Buffer (UI_Image_Length) := |
| Character'Val (Character'Pos ('0') + N mod 10); |
| end Image_Exponent; |
| |
| ------------------ |
| -- Image_String -- |
| ------------------ |
| |
| procedure Image_String (S : String) is |
| begin |
| for X of S loop |
| Image_Char (X); |
| end loop; |
| end Image_String; |
| |
| ---------------- |
| -- Image_Uint -- |
| ---------------- |
| |
| procedure Image_Uint (U : Valid_Uint) is |
| H : constant array (Int range 0 .. 15) of Character := |
| "0123456789ABCDEF"; |
| |
| Q, R : Valid_Uint; |
| begin |
| UI_Div_Rem (U, Base, Q, R); |
| |
| if Q > Uint_0 then |
| Image_Uint (Q); |
| end if; |
| |
| if Digs_Output = 4 and then Base = Uint_16 then |
| Image_Char ('_'); |
| Digs_Output := 0; |
| end if; |
| |
| Image_Char (H (UI_To_Int (R))); |
| |
| Digs_Output := Digs_Output + 1; |
| end Image_Uint; |
| |
| -- Start of processing for Image_Out |
| |
| begin |
| if No (Input) then |
| Image_String ("No_Uint"); |
| return; |
| end if; |
| |
| UI_Image_Length := 0; |
| |
| if Input < Uint_0 then |
| Image_Char ('-'); |
| Ainput := -Input; |
| else |
| Ainput := Input; |
| end if; |
| |
| if Format = Hex |
| or else (Format = Auto and then Better_In_Hex) |
| then |
| Base := Uint_16; |
| Image_Char ('1'); |
| Image_Char ('6'); |
| Image_Char ('#'); |
| Image_Uint (Ainput); |
| Image_Char ('#'); |
| |
| else |
| Base := Uint_10; |
| Image_Uint (Ainput); |
| end if; |
| |
| if Exponent /= 0 then |
| UI_Image_Length := UI_Image_Length + 1; |
| UI_Image_Buffer (UI_Image_Length) := 'E'; |
| Image_Exponent (Exponent); |
| end if; |
| |
| Uintp.Release (Marks); |
| end Image_Out; |
| |
| ------------------- |
| -- Init_Operand -- |
| ------------------- |
| |
| procedure Init_Operand (UI : Valid_Uint; Vec : out UI_Vector) is |
| Loc : Int; |
| |
| pragma Assert (Vec'First = Int'(1)); |
| |
| begin |
| if Direct (UI) then |
| Vec (1) := Direct_Val (UI); |
| |
| if Vec (1) >= Base then |
| Vec (2) := Vec (1) rem Base; |
| Vec (1) := Vec (1) / Base; |
| end if; |
| |
| else |
| Loc := Uints.Table (UI).Loc; |
| |
| for J in 1 .. Uints.Table (UI).Length loop |
| Vec (J) := Udigits.Table (Loc + J - 1); |
| end loop; |
| end if; |
| end Init_Operand; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| procedure Initialize is |
| begin |
| Uints.Init; |
| Udigits.Init; |
| |
| Uint_Int_First := UI_From_Int (Int'First); |
| Uint_Int_Last := UI_From_Int (Int'Last); |
| |
| UI_Power_2 (0) := Uint_1; |
| UI_Power_2_Set := 0; |
| |
| UI_Power_10 (0) := Uint_1; |
| UI_Power_10_Set := 0; |
| |
| Uints_Min := Uints.Last; |
| Udigits_Min := Udigits.Last; |
| |
| UI_Ints.Reset; |
| end Initialize; |
| |
| --------------------- |
| -- Least_Sig_Digit -- |
| --------------------- |
| |
| function Least_Sig_Digit (Arg : Valid_Uint) return Int is |
| V : Int; |
| |
| begin |
| if Direct (Arg) then |
| V := Direct_Val (Arg); |
| |
| if V >= Base then |
| V := V mod Base; |
| end if; |
| |
| -- Note that this result may be negative |
| |
| return V; |
| |
| else |
| return |
| Udigits.Table |
| (Uints.Table (Arg).Loc + Uints.Table (Arg).Length - 1); |
| end if; |
| end Least_Sig_Digit; |
| |
| ---------- |
| -- Mark -- |
| ---------- |
| |
| function Mark return Save_Mark is |
| begin |
| return (Save_Uint => Uints.Last, Save_Udigit => Udigits.Last); |
| end Mark; |
| |
| ----------------------- |
| -- Most_Sig_2_Digits -- |
| ----------------------- |
| |
| procedure Most_Sig_2_Digits |
| (Left : Valid_Uint; |
| Right : Valid_Uint; |
| Left_Hat : out Int; |
| Right_Hat : out Int) |
| is |
| begin |
| pragma Assert (Left >= Right); |
| |
| if Direct (Left) then |
| pragma Assert (Direct (Right)); |
| Left_Hat := Direct_Val (Left); |
| Right_Hat := Direct_Val (Right); |
| return; |
| |
| else |
| declare |
| L1 : constant Int := |
| Udigits.Table (Uints.Table (Left).Loc); |
| L2 : constant Int := |
| Udigits.Table (Uints.Table (Left).Loc + 1); |
| |
| begin |
| -- It is not so clear what to return when Arg is negative??? |
| |
| Left_Hat := abs (L1) * Base + L2; |
| end; |
| end if; |
| |
| declare |
| Length_L : constant Int := Uints.Table (Left).Length; |
| Length_R : Int; |
| R1 : Int; |
| R2 : Int; |
| T : Int; |
| |
| begin |
| if Direct (Right) then |
| T := Direct_Val (Right); |
| R1 := abs (T / Base); |
| R2 := T rem Base; |
| Length_R := 2; |
| |
| else |
| R1 := abs (Udigits.Table (Uints.Table (Right).Loc)); |
| R2 := Udigits.Table (Uints.Table (Right).Loc + 1); |
| Length_R := Uints.Table (Right).Length; |
| end if; |
| |
| if Length_L = Length_R then |
| Right_Hat := R1 * Base + R2; |
| elsif Length_L = Length_R + Int_1 then |
| Right_Hat := R1; |
| else |
| Right_Hat := 0; |
| end if; |
| end; |
| end Most_Sig_2_Digits; |
| |
| --------------- |
| -- N_Digits -- |
| --------------- |
| |
| function N_Digits (Input : Valid_Uint) return Int is |
| begin |
| if Direct (Input) then |
| if Direct_Val (Input) >= Base then |
| return 2; |
| else |
| return 1; |
| end if; |
| |
| else |
| return Uints.Table (Input).Length; |
| end if; |
| end N_Digits; |
| |
| -------------- |
| -- Num_Bits -- |
| -------------- |
| |
| function Num_Bits (Input : Valid_Uint) return Nat is |
| Bits : Nat; |
| Num : Nat; |
| |
| begin |
| -- Largest negative number has to be handled specially, since it is in |
| -- Int_Range, but we cannot take the absolute value. |
| |
| if Input = Uint_Int_First then |
| return Int'Size; |
| |
| -- For any other number in Int_Range, get absolute value of number |
| |
| elsif UI_Is_In_Int_Range (Input) then |
| Num := abs (UI_To_Int (Input)); |
| Bits := 0; |
| |
| -- If not in Int_Range then initialize bit count for all low order |
| -- words, and set number to high order digit. |
| |
| else |
| Bits := Base_Bits * (Uints.Table (Input).Length - 1); |
| Num := abs (Udigits.Table (Uints.Table (Input).Loc)); |
| end if; |
| |
| -- Increase bit count for remaining value in Num |
| |
| while Types.">" (Num, 0) loop |
| Num := Num / 2; |
| Bits := Bits + 1; |
| end loop; |
| |
| return Bits; |
| end Num_Bits; |
| |
| --------- |
| -- pid -- |
| --------- |
| |
| procedure pid (Input : Uint) is |
| begin |
| UI_Write (Input, Decimal); |
| Write_Eol; |
| end pid; |
| |
| --------- |
| -- pih -- |
| --------- |
| |
| procedure pih (Input : Uint) is |
| begin |
| UI_Write (Input, Hex); |
| Write_Eol; |
| end pih; |
| |
| ------------- |
| -- Release -- |
| ------------- |
| |
| procedure Release (M : Save_Mark) is |
| begin |
| Uints.Set_Last (Valid_Uint'Max (M.Save_Uint, Uints_Min)); |
| Udigits.Set_Last (Int'Max (M.Save_Udigit, Udigits_Min)); |
| end Release; |
| |
| ---------------------- |
| -- Release_And_Save -- |
| ---------------------- |
| |
| procedure Release_And_Save (M : Save_Mark; UI : in out Valid_Uint) is |
| begin |
| if Direct (UI) then |
| Release (M); |
| |
| else |
| declare |
| UE_Len : constant Pos := Uints.Table (UI).Length; |
| UE_Loc : constant Int := Uints.Table (UI).Loc; |
| |
| UD : constant Udigits.Table_Type (1 .. UE_Len) := |
| Udigits.Table (UE_Loc .. UE_Loc + UE_Len - 1); |
| |
| begin |
| Release (M); |
| |
| Uints.Append ((Length => UE_Len, Loc => Udigits.Last + 1)); |
| UI := Uints.Last; |
| |
| for J in 1 .. UE_Len loop |
| Udigits.Append (UD (J)); |
| end loop; |
| end; |
| end if; |
| end Release_And_Save; |
| |
| procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Valid_Uint) is |
| begin |
| if Direct (UI1) then |
| Release_And_Save (M, UI2); |
| |
| elsif Direct (UI2) then |
| Release_And_Save (M, UI1); |
| |
| else |
| declare |
| UE1_Len : constant Pos := Uints.Table (UI1).Length; |
| UE1_Loc : constant Int := Uints.Table (UI1).Loc; |
| |
| UD1 : constant Udigits.Table_Type (1 .. UE1_Len) := |
| Udigits.Table (UE1_Loc .. UE1_Loc + UE1_Len - 1); |
| |
| UE2_Len : constant Pos := Uints.Table (UI2).Length; |
| UE2_Loc : constant Int := Uints.Table (UI2).Loc; |
| |
| UD2 : constant Udigits.Table_Type (1 .. UE2_Len) := |
| Udigits.Table (UE2_Loc .. UE2_Loc + UE2_Len - 1); |
| |
| begin |
| Release (M); |
| |
| Uints.Append ((Length => UE1_Len, Loc => Udigits.Last + 1)); |
| UI1 := Uints.Last; |
| |
| for J in 1 .. UE1_Len loop |
| Udigits.Append (UD1 (J)); |
| end loop; |
| |
| Uints.Append ((Length => UE2_Len, Loc => Udigits.Last + 1)); |
| UI2 := Uints.Last; |
| |
| for J in 1 .. UE2_Len loop |
| Udigits.Append (UD2 (J)); |
| end loop; |
| end; |
| end if; |
| end Release_And_Save; |
| |
| ------------- |
| -- UI_Abs -- |
| ------------- |
| |
| function UI_Abs (Right : Valid_Uint) return Unat is |
| begin |
| if Right < Uint_0 then |
| return -Right; |
| else |
| return Right; |
| end if; |
| end UI_Abs; |
| |
| ------------- |
| -- UI_Add -- |
| ------------- |
| |
| function UI_Add (Left : Int; Right : Valid_Uint) return Valid_Uint is |
| begin |
| return UI_Add (UI_From_Int (Left), Right); |
| end UI_Add; |
| |
| function UI_Add (Left : Valid_Uint; Right : Int) return Valid_Uint is |
| begin |
| return UI_Add (Left, UI_From_Int (Right)); |
| end UI_Add; |
| |
| function UI_Add (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is |
| begin |
| pragma Assert (Present (Left)); |
| pragma Assert (Present (Right)); |
| -- Assertions are here in case we're called from C++ code, which does |
| -- not check the predicates. |
| |
| -- Simple cases of direct operands and addition of zero |
| |
| if Direct (Left) then |
| if Direct (Right) then |
| return UI_From_Int (Direct_Val (Left) + Direct_Val (Right)); |
| |
| elsif Int (Left) = Int (Uint_0) then |
| return Right; |
| end if; |
| |
| elsif Direct (Right) and then Int (Right) = Int (Uint_0) then |
| return Left; |
| end if; |
| |
| -- Otherwise full circuit is needed |
| |
| declare |
| L_Length : constant Int := N_Digits (Left); |
| R_Length : constant Int := N_Digits (Right); |
| L_Vec : UI_Vector (1 .. L_Length); |
| R_Vec : UI_Vector (1 .. R_Length); |
| Sum_Length : Int; |
| Tmp_Int : Int; |
| Carry : Int; |
| Borrow : Int; |
| X_Bigger : Boolean := False; |
| Y_Bigger : Boolean := False; |
| Result_Neg : Boolean := False; |
| |
| begin |
| Init_Operand (Left, L_Vec); |
| Init_Operand (Right, R_Vec); |
| |
| -- At least one of the two operands is in multi-digit form. |
| -- Calculate the number of digits sufficient to hold result. |
| |
| if L_Length > R_Length then |
| Sum_Length := L_Length + 1; |
| X_Bigger := True; |
| else |
| Sum_Length := R_Length + 1; |
| |
| if R_Length > L_Length then |
| Y_Bigger := True; |
| end if; |
| end if; |
| |
| -- Make copies of the absolute values of L_Vec and R_Vec into X and Y |
| -- both with lengths equal to the maximum possibly needed. This makes |
| -- looping over the digits much simpler. |
| |
| declare |
| X : UI_Vector (1 .. Sum_Length); |
| Y : UI_Vector (1 .. Sum_Length); |
| Tmp_UI : UI_Vector (1 .. Sum_Length); |
| |
| begin |
| for J in 1 .. Sum_Length - L_Length loop |
| X (J) := 0; |
| end loop; |
| |
| X (Sum_Length - L_Length + 1) := abs L_Vec (1); |
| |
| for J in 2 .. L_Length loop |
| X (J + (Sum_Length - L_Length)) := L_Vec (J); |
| end loop; |
| |
| for J in 1 .. Sum_Length - R_Length loop |
| Y (J) := 0; |
| end loop; |
| |
| Y (Sum_Length - R_Length + 1) := abs R_Vec (1); |
| |
| for J in 2 .. R_Length loop |
| Y (J + (Sum_Length - R_Length)) := R_Vec (J); |
| end loop; |
| |
| if (L_Vec (1) < Int_0) = (R_Vec (1) < Int_0) then |
| |
| -- Same sign so just add |
| |
| Carry := 0; |
| for J in reverse 1 .. Sum_Length loop |
| Tmp_Int := X (J) + Y (J) + Carry; |
| |
| if Tmp_Int >= Base then |
| Tmp_Int := Tmp_Int - Base; |
| Carry := 1; |
| else |
| Carry := 0; |
| end if; |
| |
| X (J) := Tmp_Int; |
| end loop; |
| |
| return Vector_To_Uint (X, L_Vec (1) < Int_0); |
| |
| else |
| -- Find which one has bigger magnitude |
| |
| if not (X_Bigger or Y_Bigger) then |
| for J in L_Vec'Range loop |
| if abs L_Vec (J) > abs R_Vec (J) then |
| X_Bigger := True; |
| exit; |
| elsif abs R_Vec (J) > abs L_Vec (J) then |
| Y_Bigger := True; |
| exit; |
| end if; |
| end loop; |
| end if; |
| |
| -- If they have identical magnitude, just return 0, else swap |
| -- if necessary so that X had the bigger magnitude. Determine |
| -- if result is negative at this time. |
| |
| Result_Neg := False; |
| |
| if not (X_Bigger or Y_Bigger) then |
| return Uint_0; |
| |
| elsif Y_Bigger then |
| if R_Vec (1) < Int_0 then |
| Result_Neg := True; |
| end if; |
| |
| Tmp_UI := X; |
| X := Y; |
| Y := Tmp_UI; |
| |
| else |
| if L_Vec (1) < Int_0 then |
| Result_Neg := True; |
| end if; |
| end if; |
| |
| -- Subtract Y from the bigger X |
| |
| Borrow := 0; |
| |
| for J in reverse 1 .. Sum_Length loop |
| Tmp_Int := X (J) - Y (J) + Borrow; |
| |
| if Tmp_Int < Int_0 then |
| Tmp_Int := Tmp_Int + Base; |
| Borrow := -1; |
| else |
| Borrow := 0; |
| end if; |
| |
| X (J) := Tmp_Int; |
| end loop; |
| |
| return Vector_To_Uint (X, Result_Neg); |
| |
| end if; |
| end; |
| end; |
| end UI_Add; |
| |
| -------------------------- |
| -- UI_Decimal_Digits_Hi -- |
| -------------------------- |
| |
| function UI_Decimal_Digits_Hi (U : Valid_Uint) return Nat is |
| begin |
| -- The maximum value of a "digit" is 32767, which is 5 decimal digits, |
| -- so an N_Digit number could take up to 5 times this number of digits. |
| -- This is certainly too high for large numbers but it is not worth |
| -- worrying about. |
| |
| return 5 * N_Digits (U); |
| end UI_Decimal_Digits_Hi; |
| |
| -------------------------- |
| -- UI_Decimal_Digits_Lo -- |
| -------------------------- |
| |
| function UI_Decimal_Digits_Lo (U : Valid_Uint) return Nat is |
| begin |
| -- The maximum value of a "digit" is 32767, which is more than four |
| -- decimal digits, but not a full five digits. The easily computed |
| -- minimum number of decimal digits is thus 1 + 4 * the number of |
| -- digits. This is certainly too low for large numbers but it is not |
| -- worth worrying about. |
| |
| return 1 + 4 * (N_Digits (U) - 1); |
| end UI_Decimal_Digits_Lo; |
| |
| ------------ |
| -- UI_Div -- |
| ------------ |
| |
| function UI_Div (Left : Int; Right : Nonzero_Uint) return Valid_Uint is |
| begin |
| return UI_Div (UI_From_Int (Left), Right); |
| end UI_Div; |
| |
| function UI_Div |
| (Left : Valid_Uint; Right : Nonzero_Int) return Valid_Uint |
| is |
| begin |
| return UI_Div (Left, UI_From_Int (Right)); |
| end UI_Div; |
| |
| function UI_Div |
| (Left : Valid_Uint; Right : Nonzero_Uint) return Valid_Uint |
| is |
| Quotient : Valid_Uint; |
| Ignored_Remainder : Uint; |
| begin |
| UI_Div_Rem |
| (Left, Right, |
| Quotient, Ignored_Remainder, |
| Discard_Remainder => True); |
| return Quotient; |
| end UI_Div; |
| |
| ---------------- |
| -- UI_Div_Rem -- |
| ---------------- |
| |
| procedure UI_Div_Rem |
| (Left, Right : Valid_Uint; |
| Quotient : out Uint; |
| Remainder : out Uint; |
| Discard_Quotient : Boolean := False; |
| Discard_Remainder : Boolean := False) |
| is |
| begin |
| pragma Assert (Right /= Uint_0); |
| |
| Quotient := No_Uint; |
| Remainder := No_Uint; |
| |
| -- Cases where both operands are represented directly |
| |
| if Direct (Left) and then Direct (Right) then |
| declare |
| DV_Left : constant Int := Direct_Val (Left); |
| DV_Right : constant Int := Direct_Val (Right); |
| |
| begin |
| if not Discard_Quotient then |
| Quotient := UI_From_Int (DV_Left / DV_Right); |
| end if; |
| |
| if not Discard_Remainder then |
| Remainder := UI_From_Int (DV_Left rem DV_Right); |
| end if; |
| |
| return; |
| end; |
| end if; |
| |
| declare |
| L_Length : constant Int := N_Digits (Left); |
| R_Length : constant Int := N_Digits (Right); |
| Q_Length : constant Int := L_Length - R_Length + 1; |
| L_Vec : UI_Vector (1 .. L_Length); |
| R_Vec : UI_Vector (1 .. R_Length); |
| D : Int; |
| Remainder_I : Int; |
| Tmp_Divisor : Int; |
| Carry : Int; |
| Tmp_Int : Int; |
| Tmp_Dig : Int; |
| |
| procedure UI_Div_Vector |
| (L_Vec : UI_Vector; |
| R_Int : Int; |
| Quotient : out UI_Vector; |
| Remainder : out Int); |
| pragma Inline (UI_Div_Vector); |
| -- Specialised variant for case where the divisor is a single digit |
| |
| procedure UI_Div_Vector |
| (L_Vec : UI_Vector; |
| R_Int : Int; |
| Quotient : out UI_Vector; |
| Remainder : out Int) |
| is |
| Tmp_Int : Int; |
| |
| begin |
| Remainder := 0; |
| for J in L_Vec'Range loop |
| Tmp_Int := Remainder * Base + abs L_Vec (J); |
| Quotient (Quotient'First + J - L_Vec'First) := Tmp_Int / R_Int; |
| Remainder := Tmp_Int rem R_Int; |
| end loop; |
| |
| if L_Vec (L_Vec'First) < Int_0 then |
| Remainder := -Remainder; |
| end if; |
| end UI_Div_Vector; |
| |
| -- Start of processing for UI_Div_Rem |
| |
| begin |
| -- Result is zero if left operand is shorter than right |
| |
| if L_Length < R_Length then |
| if not Discard_Quotient then |
| Quotient := Uint_0; |
| end if; |
| |
| if not Discard_Remainder then |
| Remainder := Left; |
| end if; |
| |
| return; |
| end if; |
| |
| Init_Operand (Left, L_Vec); |
| Init_Operand (Right, R_Vec); |
| |
| -- Case of right operand is single digit. Here we can simply divide |
| -- each digit of the left operand by the divisor, from most to least |
| -- significant, carrying the remainder to the next digit (just like |
| -- ordinary long division by hand). |
| |
| if R_Length = Int_1 then |
| Tmp_Divisor := abs R_Vec (1); |
| |
| declare |
| Quotient_V : UI_Vector (1 .. L_Length); |
| |
| begin |
| UI_Div_Vector (L_Vec, Tmp_Divisor, Quotient_V, Remainder_I); |
| |
| if not Discard_Quotient then |
| Quotient := |
| Vector_To_Uint |
| (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0)); |
| end if; |
| |
| if not Discard_Remainder then |
| Remainder := UI_From_Int (Remainder_I); |
| end if; |
| |
| return; |
| end; |
| end if; |
| |
| -- The possible simple cases have been exhausted. Now turn to the |
| -- algorithm D from the section of Knuth mentioned at the top of |
| -- this package. |
| |
| Algorithm_D : declare |
| Dividend : UI_Vector (1 .. L_Length + 1); |
| Divisor : UI_Vector (1 .. R_Length); |
| Quotient_V : UI_Vector (1 .. Q_Length); |
| Divisor_Dig1 : Int; |
| Divisor_Dig2 : Int; |
| Q_Guess : Int; |
| R_Guess : Int; |
| |
| begin |
| -- [ NORMALIZE ] (step D1 in the algorithm). First calculate the |
| -- scale d, and then multiply Left and Right (u and v in the book) |
| -- by d to get the dividend and divisor to work with. |
| |
| D := Base / (abs R_Vec (1) + 1); |
| |
| Dividend (1) := 0; |
| Dividend (2) := abs L_Vec (1); |
| |
| for J in 3 .. L_Length + Int_1 loop |
| Dividend (J) := L_Vec (J - 1); |
| end loop; |
| |
| Divisor (1) := abs R_Vec (1); |
| |
| for J in Int_2 .. R_Length loop |
| Divisor (J) := R_Vec (J); |
| end loop; |
| |
| if D > Int_1 then |
| |
| -- Multiply Dividend by d |
| |
| Carry := 0; |
| for J in reverse Dividend'Range loop |
| Tmp_Int := Dividend (J) * D + Carry; |
| Dividend (J) := Tmp_Int rem Base; |
| Carry := Tmp_Int / Base; |
| end loop; |
| |
| -- Multiply Divisor by d |
| |
| Carry := 0; |
| for J in reverse Divisor'Range loop |
| Tmp_Int := Divisor (J) * D + Carry; |
| Divisor (J) := Tmp_Int rem Base; |
| Carry := Tmp_Int / Base; |
| end loop; |
| end if; |
| |
| -- Main loop of long division algorithm |
| |
| Divisor_Dig1 := Divisor (1); |
| Divisor_Dig2 := Divisor (2); |
| |
| for J in Quotient_V'Range loop |
| |
| -- [ CALCULATE Q (hat) ] (step D3 in the algorithm) |
| |
| -- Note: this version of step D3 is from the original published |
| -- algorithm, which is known to have a bug causing overflows. |
| -- See: http://www-cs-faculty.stanford.edu/~uno/err2-2e.ps.gz |
| -- and http://www-cs-faculty.stanford.edu/~uno/all2-pre.ps.gz. |
| -- The code below is the fixed version of this step. |
| |
| Tmp_Int := Dividend (J) * Base + Dividend (J + 1); |
| |
| -- Initial guess |
| |
| Q_Guess := Tmp_Int / Divisor_Dig1; |
| R_Guess := Tmp_Int rem Divisor_Dig1; |
| |
| -- Refine the guess |
| |
| while Q_Guess >= Base |
| or else Divisor_Dig2 * Q_Guess > |
| R_Guess * Base + Dividend (J + 2) |
| loop |
| Q_Guess := Q_Guess - 1; |
| R_Guess := R_Guess + Divisor_Dig1; |
| exit when R_Guess >= Base; |
| end loop; |
| |
| -- [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is |
| -- subtracted from the remaining dividend. |
| |
| Carry := 0; |
| for K in reverse Divisor'Range loop |
| Tmp_Int := Dividend (J + K) - Q_Guess * Divisor (K) + Carry; |
| Tmp_Dig := Tmp_Int rem Base; |
| Carry := Tmp_Int / Base; |
| |
| if Tmp_Dig < Int_0 then |
| Tmp_Dig := Tmp_Dig + Base; |
| Carry := Carry - 1; |
| end if; |
| |
| Dividend (J + K) := Tmp_Dig; |
| end loop; |
| |
| Dividend (J) := Dividend (J) + Carry; |
| |
| -- [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6) |
| |
| -- Here there is a slight difference from the book: the last |
| -- carry is always added in above and below (cancelling each |
| -- other). In fact the dividend going negative is used as |
| -- the test. |
| |
| -- If the Dividend went negative, then Q_Guess was off by |
| -- one, so it is decremented, and the divisor is added back |
| -- into the relevant portion of the dividend. |
| |
| if Dividend (J) < Int_0 then |
| Q_Guess := Q_Guess - 1; |
| |
| Carry := 0; |
| for K in reverse Divisor'Range loop |
| Tmp_Int := Dividend (J + K) + Divisor (K) + Carry; |
| |
| if Tmp_Int >= Base then |
| Tmp_Int := Tmp_Int - Base; |
| Carry := 1; |
| else |
| Carry := 0; |
| end if; |
| |
| Dividend (J + K) := Tmp_Int; |
| end loop; |
| |
| Dividend (J) := Dividend (J) + Carry; |
| end if; |
| |
| -- Finally we can get the next quotient digit |
| |
| Quotient_V (J) := Q_Guess; |
| end loop; |
| |
| -- [ UNNORMALIZE ] (step D8) |
| |
| if not Discard_Quotient then |
| Quotient := Vector_To_Uint |
| (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0)); |
| end if; |
| |
| if not Discard_Remainder then |
| declare |
| Remainder_V : UI_Vector (1 .. R_Length); |
| Ignore : Int; |
| begin |
| pragma Assert (D /= Int'(0)); |
| UI_Div_Vector |
| (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last), |
| D, |
| Remainder_V, Ignore); |
| Remainder := Vector_To_Uint (Remainder_V, L_Vec (1) < Int_0); |
| end; |
| end if; |
| end Algorithm_D; |
| end; |
| end UI_Div_Rem; |
| |
| ------------ |
| -- UI_Eq -- |
| ------------ |
| |
| function UI_Eq (Left : Int; Right : Valid_Uint) return Boolean is |
| begin |
| return not UI_Ne (UI_From_Int (Left), Right); |
| end UI_Eq; |
| |
| function UI_Eq (Left : Valid_Uint; Right : Int) return Boolean is |
| begin |
| return not UI_Ne (Left, UI_From_Int (Right)); |
| end UI_Eq; |
| |
| function UI_Eq (Left : Valid_Uint; Right : Valid_Uint) return Boolean is |
| begin |
| return not UI_Ne (Left, Right); |
| end UI_Eq; |
| |
| -------------- |
| -- UI_Expon -- |
| -------------- |
| |
| function UI_Expon (Left : Int; Right : Unat) return Valid_Uint is |
| begin |
| return UI_Expon (UI_From_Int (Left), Right); |
| end UI_Expon; |
| |
| function UI_Expon (Left : Valid_Uint; Right : Nat) return Valid_Uint is |
| begin |
| return UI_Expon (Left, UI_From_Int (Right)); |
| end UI_Expon; |
| |
| function UI_Expon (Left : Int; Right : Nat) return Valid_Uint is |
| begin |
| return UI_Expon (UI_From_Int (Left), UI_From_Int (Right)); |
| end UI_Expon; |
| |
| function UI_Expon |
| (Left : Valid_Uint; Right : Unat) return Valid_Uint |
| is |
| begin |
| pragma Assert (Right >= Uint_0); |
| |
| -- Any value raised to power of 0 is 1 |
| |
| if Right = Uint_0 then |
| return Uint_1; |
| |
| -- 0 to any positive power is 0 |
| |
| elsif Left = Uint_0 then |
| return Uint_0; |
| |
| -- 1 to any power is 1 |
| |
| elsif Left = Uint_1 then |
| return Uint_1; |
| |
| -- Any value raised to power of 1 is that value |
| |
| elsif Right = Uint_1 then |
| return Left; |
| |
| -- Cases which can be done by table lookup |
| |
| elsif Right <= Uint_128 then |
| |
| -- 2**N for N in 2 .. 128 |
| |
| if Left = Uint_2 then |
| declare |
| Right_Int : constant Int := Direct_Val (Right); |
| |
| begin |
| if Right_Int > UI_Power_2_Set then |
| for J in UI_Power_2_Set + Int_1 .. Right_Int loop |
| UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2; |
| Uints_Min := Uints.Last; |
| Udigits_Min := Udigits.Last; |
| end loop; |
| |
| UI_Power_2_Set := Right_Int; |
| end if; |
| |
| return UI_Power_2 (Right_Int); |
| end; |
| |
| -- 10**N for N in 2 .. 128 |
| |
| elsif Left = Uint_10 then |
| declare |
| Right_Int : constant Int := Direct_Val (Right); |
| |
| begin |
| if Right_Int > UI_Power_10_Set then |
| for J in UI_Power_10_Set + Int_1 .. Right_Int loop |
| UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10); |
| Uints_Min := Uints.Last; |
| Udigits_Min := Udigits.Last; |
| end loop; |
| |
| UI_Power_10_Set := Right_Int; |
| end if; |
| |
| return UI_Power_10 (Right_Int); |
| end; |
| end if; |
| end if; |
| |
| -- If we fall through, then we have the general case (see Knuth 4.6.3) |
| |
| declare |
| N : Valid_Uint := Right; |
| Squares : Valid_Uint := Left; |
| Result : Valid_Uint := Uint_1; |
| M : constant Uintp.Save_Mark := Uintp.Mark; |
| |
| begin |
| loop |
| if (Least_Sig_Digit (N) mod Int_2) = Int_1 then |
| Result := Result * Squares; |
| end if; |
| |
| N := N / Uint_2; |
| exit when N = Uint_0; |
| Squares := Squares * Squares; |
| end loop; |
| |
| Uintp.Release_And_Save (M, Result); |
| return Result; |
| end; |
| end UI_Expon; |
| |
| ---------------- |
| -- UI_From_CC -- |
| ---------------- |
| |
| function UI_From_CC (Input : Char_Code) return Valid_Uint is |
| begin |
| return UI_From_Int (Int (Input)); |
| end UI_From_CC; |
| |
| ----------------- |
| -- UI_From_Int -- |
| ----------------- |
| |
| function UI_From_Int (Input : Int) return Valid_Uint is |
| U : Uint; |
| |
| begin |
| if Min_Direct <= Input and then Input <= Max_Direct then |
| return Valid_Uint (Int (Uint_Direct_Bias) + Input); |
| end if; |
| |
| -- If already in the hash table, return entry |
| |
| U := UI_Ints.Get (Input); |
| |
| if Present (U) then |
| return U; |
| end if; |
| |
| -- For values of larger magnitude, compute digits into a vector and call |
| -- Vector_To_Uint. |
| |
| declare |
| Max_For_Int : constant := 3; |
| -- Base is defined so that 3 Uint digits is sufficient to hold the |
| -- largest possible Int value. |
| |
| V : UI_Vector (1 .. Max_For_Int); |
| |
| Temp_Integer : Int := Input; |
| |
| begin |
| for J in reverse V'Range loop |
| V (J) := abs (Temp_Integer rem Base); |
| Temp_Integer := Temp_Integer / Base; |
| end loop; |
| |
| U := Vector_To_Uint (V, Input < Int_0); |
| UI_Ints.Set (Input, U); |
| Uints_Min := Uints.Last; |
| Udigits_Min := Udigits.Last; |
| return U; |
| end; |
| end UI_From_Int; |
| |
| ---------------------- |
| -- UI_From_Integral -- |
| ---------------------- |
| |
| function UI_From_Integral (Input : In_T) return Valid_Uint is |
| begin |
| -- If in range of our normal conversion function, use it so we can use |
| -- direct access and our cache. |
| |
| if In_T'Size <= Int'Size |
| or else Input in In_T (Int'First) .. In_T (Int'Last) |
| then |
| return UI_From_Int (Int (Input)); |
| |
| else |
| -- For values of larger magnitude, compute digits into a vector and |
| -- call Vector_To_Uint. |
| |
| declare |
| Max_For_In_T : constant Int := 3 * In_T'Size / Int'Size; |
| Our_Base : constant In_T := In_T (Base); |
| Temp_Integer : In_T := Input; |
| -- Base is defined so that 3 Uint digits is sufficient to hold the |
| -- largest possible Int value. |
| |
| U : Valid_Uint; |
| V : UI_Vector (1 .. Max_For_In_T); |
| |
| begin |
| for J in reverse V'Range loop |
| V (J) := Int (abs (Temp_Integer rem Our_Base)); |
| Temp_Integer := Temp_Integer / Our_Base; |
| end loop; |
| |
| U := Vector_To_Uint (V, Input < 0); |
| Uints_Min := Uints.Last; |
| Udigits_Min := Udigits.Last; |
| |
| return U; |
| end; |
| end if; |
| end UI_From_Integral; |
| |
| ------------ |
| -- UI_GCD -- |
| ------------ |
| |
| -- Lehmer's algorithm for GCD |
| |
| -- The idea is to avoid using multiple precision arithmetic wherever |
| -- possible, substituting Int arithmetic instead. See Knuth volume II, |
| -- Algorithm L (page 329). |
| |
| -- We use the same notation as Knuth (U_Hat standing for the obvious) |
| |
| function UI_GCD (Uin, Vin : Valid_Uint) return Valid_Uint is |
| U, V : Valid_Uint; |
| -- Copies of Uin and Vin |
| |
| U_Hat, V_Hat : Int; |
| -- The most Significant digits of U,V |
| |
| A, B, C, D, T, Q, Den1, Den2 : Int; |
| |
| Tmp_UI : Valid_Uint; |
| Marks : constant Uintp.Save_Mark := Uintp.Mark; |
| Iterations : Integer := 0; |
| |
| begin |
| pragma Assert (Uin >= Vin); |
| pragma Assert (Vin >= Uint_0); |
| |
| U := Uin; |
| V := Vin; |
| |
| loop |
| Iterations := Iterations + 1; |
| |
| if Direct (V) then |
| if V = Uint_0 then |
| return U; |
| else |
| return |
| UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V))); |
| end if; |
| end if; |
| |
| Most_Sig_2_Digits (U, V, U_Hat, V_Hat); |
| A := 1; |
| B := 0; |
| C := 0; |
| D := 1; |
| |
| loop |
| -- We might overflow and get division by zero here. This just |
| -- means we cannot take the single precision step |
| |
| Den1 := V_Hat + C; |
| Den2 := V_Hat + D; |
| exit when Den1 = Int_0 or else Den2 = Int_0; |
| |
| -- Compute Q, the trial quotient |
| |
| Q := (U_Hat + A) / Den1; |
| |
| exit when Q /= ((U_Hat + B) / Den2); |
| |
| -- A single precision step Euclid step will give same answer as a |
| -- multiprecision one. |
| |
| T := A - (Q * C); |
| A := C; |
| C := T; |
| |
| T := B - (Q * D); |
| B := D; |
| D := T; |
| |
| T := U_Hat - (Q * V_Hat); |
| U_Hat := V_Hat; |
| V_Hat := T; |
| |
| end loop; |
| |
| -- Take a multiprecision Euclid step |
| |
| if B = Int_0 then |
| |
| -- No single precision steps take a regular Euclid step |
| |
| Tmp_UI := U rem V; |
| U := V; |
| V := Tmp_UI; |
| |
| else |
| -- Use prior single precision steps to compute this Euclid step |
| |
| Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V); |
| V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V); |
| U := Tmp_UI; |
| end if; |
| |
| -- If the operands are very different in magnitude, the loop will |
| -- generate large amounts of short-lived data, which it is worth |
| -- removing periodically. |
| |
| if Iterations > 100 then |
| Release_And_Save (Marks, U, V); |
| Iterations := 0; |
| end if; |
| end loop; |
| end UI_GCD; |
| |
| ------------ |
| -- UI_Ge -- |
| ------------ |
| |
| function UI_Ge (Left : Int; Right : Valid_Uint) return Boolean is |
| begin |
| return not UI_Lt (UI_From_Int (Left), Right); |
| end UI_Ge; |
| |
| function UI_Ge (Left : Valid_Uint; Right : Int) return Boolean is |
| begin |
| return not UI_Lt (Left, UI_From_Int (Right)); |
| end UI_Ge; |
| |
| function UI_Ge (Left : Valid_Uint; Right : Valid_Uint) return Boolean is |
| begin |
| return not UI_Lt (Left, Right); |
| end UI_Ge; |
| |
| ------------ |
| -- UI_Gt -- |
| ------------ |
| |
| function UI_Gt (Left : Int; Right : Valid_Uint) return Boolean is |
| begin |
| return UI_Lt (Right, UI_From_Int (Left)); |
| end UI_Gt; |
| |
| function UI_Gt (Left : Valid_Uint; Right : Int) return Boolean is |
| begin |
| return UI_Lt (UI_From_Int (Right), Left); |
| end UI_Gt; |
| |
| function UI_Gt (Left : Valid_Uint; Right : Valid_Uint) return Boolean is |
| begin |
| return UI_Lt (Left => Right, Right => Left); |
| end UI_Gt; |
| |
| --------------- |
| -- UI_Image -- |
| --------------- |
| |
| procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is |
| begin |
| Image_Out (Input, True, Format); |
| end UI_Image; |
| |
| function UI_Image |
| (Input : Uint; |
| Format : UI_Format := Auto) return String |
| is |
| begin |
| Image_Out (Input, True, Format); |
| return UI_Image_Buffer (1 .. UI_Image_Length); |
| end UI_Image; |
| |
| ------------------------- |
| -- UI_Is_In_Int_Range -- |
| ------------------------- |
| |
| function UI_Is_In_Int_Range (Input : Valid_Uint) return Boolean is |
| pragma Assert (Present (Input)); |
| -- Assertion is here in case we're called from C++ code, which does |
| -- not check the predicates. |
| begin |
| -- Make sure we don't get called before Initialize |
| |
| pragma Assert (Uint_Int_First /= Uint_0); |
| |
| if Direct (Input) then |
| return True; |
| else |
| return Input >= Uint_Int_First and then Input <= Uint_Int_Last; |
| end if; |
| end UI_Is_In_Int_Range; |
| |
| ------------ |
| -- UI_Le -- |
| ------------ |
| |
| function UI_Le (Left : Int; Right : Valid_Uint) return Boolean is |
| begin |
| return not UI_Lt (Right, UI_From_Int (Left)); |
| end UI_Le; |
| |
| function UI_Le (Left : Valid_Uint; Right : Int) return Boolean is |
| begin |
| return not UI_Lt (UI_From_Int (Right), Left); |
| end UI_Le; |
| |
| function UI_Le (Left : Valid_Uint; Right : Valid_Uint) return Boolean is |
| begin |
| return not UI_Lt (Left => Right, Right => Left); |
| end UI_Le; |
| |
| ------------ |
| -- UI_Lt -- |
| ------------ |
| |
| function UI_Lt (Left : Int; Right : Valid_Uint) return Boolean is |
| begin |
| return UI_Lt (UI_From_Int (Left), Right); |
| end UI_Lt; |
| |
| function UI_Lt (Left : Valid_Uint; Right : Int) return Boolean is |
| begin |
| return UI_Lt (Left, UI_From_Int (Right)); |
| end UI_Lt; |
| |
| function UI_Lt (Left : Valid_Uint; Right : Valid_Uint) return Boolean is |
| begin |
| pragma Assert (Present (Left)); |
| pragma Assert (Present (Right)); |
| -- Assertions are here in case we're called from C++ code, which does |
| -- not check the predicates. |
| |
| -- Quick processing for identical arguments |
| |
| if Int (Left) = Int (Right) then |
| return False; |
| |
| -- Quick processing for both arguments directly represented |
| |
| elsif Direct (Left) and then Direct (Right) then |
| return Int (Left) < Int (Right); |
| |
| -- At least one argument is more than one digit long |
| |
| else |
| declare |
| L_Length : constant Int := N_Digits (Left); |
| R_Length : constant Int := N_Digits (Right); |
| |
| L_Vec : UI_Vector (1 .. L_Length); |
| R_Vec : UI_Vector (1 .. R_Length); |
| |
| begin |
| Init_Operand (Left, L_Vec); |
| Init_Operand (Right, R_Vec); |
| |
| if L_Vec (1) < Int_0 then |
| |
| -- First argument negative, second argument non-negative |
| |
| if R_Vec (1) >= Int_0 then |
| return True; |
| |
| -- Both arguments negative |
| |
| else |
| if L_Length /= R_Length then |
| return L_Length > R_Length; |
| |
| elsif L_Vec (1) /= R_Vec (1) then |
| return L_Vec (1) < R_Vec (1); |
| |
| else |
| for J in 2 .. L_Vec'Last loop |
| if L_Vec (J) /= R_Vec (J) then |
| return L_Vec (J) > R_Vec (J); |
| end if; |
| end loop; |
| |
| return False; |
| end if; |
| end if; |
| |
| else |
| -- First argument non-negative, second argument negative |
| |
| if R_Vec (1) < Int_0 then |
| return False; |
| |
| -- Both arguments non-negative |
| |
| else |
| if L_Length /= R_Length then |
| return L_Length < R_Length; |
| else |
| for J in L_Vec'Range loop |
| if L_Vec (J) /= R_Vec (J) then |
| return L_Vec (J) < R_Vec (J); |
| end if; |
| end loop; |
| |
| return False; |
| end if; |
| end if; |
| end if; |
| end; |
| end if; |
| end UI_Lt; |
| |
| ------------ |
| -- UI_Max -- |
| ------------ |
| |
| function UI_Max (Left : Int; Right : Valid_Uint) return Valid_Uint is |
| begin |
| return UI_Max (UI_From_Int (Left), Right); |
| end UI_Max; |
| |
| function UI_Max (Left : Valid_Uint; Right : Int) return Valid_Uint is |
| begin |
| return UI_Max (Left, UI_From_Int (Right)); |
| end UI_Max; |
| |
| function UI_Max (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is |
| begin |
| if Left >= Right then |
| return Left; |
| else |
| return Right; |
| end if; |
| end UI_Max; |
| |
| ------------ |
| -- UI_Min -- |
| ------------ |
| |
| function UI_Min (Left : Int; Right : Valid_Uint) return Valid_Uint is |
| begin |
| return UI_Min (UI_From_Int (Left), Right); |
| end UI_Min; |
| |
| function UI_Min (Left : Valid_Uint; Right : Int) return Valid_Uint is |
| begin |
| return UI_Min (Left, UI_From_Int (Right)); |
| end UI_Min; |
| |
| function UI_Min (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is |
| begin |
| if Left <= Right then |
| return Left; |
| else |
| return Right; |
| end if; |
| end UI_Min; |
| |
| ------------- |
| -- UI_Mod -- |
| ------------- |
| |
| function UI_Mod (Left : Int; Right : Nonzero_Uint) return Valid_Uint is |
| begin |
| return UI_Mod (UI_From_Int (Left), Right); |
| end UI_Mod; |
| |
| function UI_Mod |
| (Left : Valid_Uint; Right : Nonzero_Int) return Valid_Uint |
| is |
| begin |
| return UI_Mod (Left, UI_From_Int (Right)); |
| end UI_Mod; |
| |
| function UI_Mod |
| (Left : Valid_Uint; Right : Nonzero_Uint) return Valid_Uint |
| is |
| Urem : constant Valid_Uint := Left rem Right; |
| |
| begin |
| if (Left < Uint_0) = (Right < Uint_0) |
| or else Urem = Uint_0 |
| then |
| return Urem; |
| else |
| return Right + Urem; |
| end if; |
| end UI_Mod; |
| |
| ------------------------------- |
| -- UI_Modular_Exponentiation -- |
| ------------------------------- |
| |
| function UI_Modular_Exponentiation |
| (B : Valid_Uint; |
| E : Valid_Uint; |
| Modulo : Valid_Uint) return Valid_Uint |
| is |
| M : constant Save_Mark := Mark; |
| |
| Result : Valid_Uint := Uint_1; |
| Base : Valid_Uint := B; |
| Exponent : Valid_Uint := E; |
| |
| begin |
| while Exponent /= Uint_0 loop |
| if Least_Sig_Digit (Exponent) rem Int'(2) = Int'(1) then |
| Result := (Result * Base) rem Modulo; |
| end if; |
| |
| Exponent := Exponent / Uint_2; |
| Base := (Base * Base) rem Modulo; |
| end loop; |
| |
| Release_And_Save (M, Result); |
| return Result; |
| end UI_Modular_Exponentiation; |
| |
| ------------------------ |
| -- UI_Modular_Inverse -- |
| ------------------------ |
| |
| function UI_Modular_Inverse |
| (N : Valid_Uint; Modulo : Valid_Uint) return Valid_Uint |
| is |
| M : constant Save_Mark := Mark; |
| U : Valid_Uint; |
| V : Valid_Uint; |
| Q : Valid_Uint; |
| R : Valid_Uint; |
| X : Valid_Uint; |
| Y : Valid_Uint; |
| T : Valid_Uint; |
| S : Int := 1; |
| |
| begin |
| U := Modulo; |
| V := N; |
| |
| X := Uint_1; |
| Y := Uint_0; |
| |
| loop |
| UI_Div_Rem (U, V, Quotient => Q, Remainder => R); |
| |
| U := V; |
| V := R; |
| |
| T := X; |
| X := Y + Q * X; |
| Y := T; |
| S := -S; |
| |
| exit when R = Uint_1; |
| end loop; |
| |
| if S = Int'(-1) then |
| X := Modulo - X; |
| end if; |
| |
| Release_And_Save (M, X); |
| return X; |
| end UI_Modular_Inverse; |
| |
| ------------ |
| -- UI_Mul -- |
| ------------ |
| |
| function UI_Mul (Left : Int; Right : Valid_Uint) return Valid_Uint is |
| begin |
| return UI_Mul (UI_From_Int (Left), Right); |
| end UI_Mul; |
| |
| function UI_Mul (Left : Valid_Uint; Right : Int) return Valid_Uint is |
| begin |
| return UI_Mul (Left, UI_From_Int (Right)); |
| end UI_Mul; |
| |
| function UI_Mul (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is |
| begin |
| -- Case where product fits in the range of a 32-bit integer |
| |
| if Int (Left) <= Int (Uint_Max_Simple_Mul) |
| and then |
| Int (Right) <= Int (Uint_Max_Simple_Mul) |
| then |
| return UI_From_Int (Direct_Val (Left) * Direct_Val (Right)); |
| end if; |
| |
| -- Otherwise we have the general case (Algorithm M in Knuth) |
| |
| declare |
| L_Length : constant Int := N_Digits (Left); |
| R_Length : constant Int := N_Digits (Right); |
| L_Vec : UI_Vector (1 .. L_Length); |
| R_Vec : UI_Vector (1 .. R_Length); |
| Neg : Boolean; |
| |
| begin |
| Init_Operand (Left, L_Vec); |
| Init_Operand (Right, R_Vec); |
| Neg := (L_Vec (1) < Int_0) xor (R_Vec (1) < Int_0); |
| L_Vec (1) := abs (L_Vec (1)); |
| R_Vec (1) := abs (R_Vec (1)); |
| |
| Algorithm_M : declare |
| Product : UI_Vector (1 .. L_Length + R_Length); |
| Tmp_Sum : Int; |
| Carry : Int; |
| |
| begin |
| for J in Product'Range loop |
| Product (J) := 0; |
| end loop; |
| |
| for J in reverse R_Vec'Range loop |
| Carry := 0; |
| for K in reverse L_Vec'Range loop |
| Tmp_Sum := |
| L_Vec (K) * R_Vec (J) + Product (J + K) + Carry; |
| Product (J + K) := Tmp_Sum rem Base; |
| Carry := Tmp_Sum / Base; |
| end loop; |
| |
| Product (J) := Carry; |
| end loop; |
| |
| return Vector_To_Uint (Product, Neg); |
| end Algorithm_M; |
| end; |
| end UI_Mul; |
| |
| ------------ |
| -- UI_Ne -- |
| ------------ |
| |
| function UI_Ne (Left : Int; Right : Valid_Uint) return Boolean is |
| begin |
| return UI_Ne (UI_From_Int (Left), Right); |
| end UI_Ne; |
| |
| function UI_Ne (Left : Valid_Uint; Right : Int) return Boolean is |
| begin |
| return UI_Ne (Left, UI_From_Int (Right)); |
| end UI_Ne; |
| |
| function UI_Ne (Left : Valid_Uint; Right : Valid_Uint) return Boolean is |
| begin |
| pragma Assert (Present (Left)); |
| pragma Assert (Present (Right)); |
| -- Assertions are here in case we're called from C++ code, which does |
| -- not check the predicates. |
| |
| -- Quick processing for identical arguments |
| |
| if Int (Left) = Int (Right) then |
| return False; |
| end if; |
| |
| -- See if left operand directly represented |
| |
| if Direct (Left) then |
| |
| -- If right operand directly represented then compare |
| |
| if Direct (Right) then |
| return Int (Left) /= Int (Right); |
| |
| -- Left operand directly represented, right not, must be unequal |
| |
| else |
| return True; |
| end if; |
| |
| -- Right operand directly represented, left not, must be unequal |
| |
| elsif Direct (Right) then |
| return True; |
| end if; |
| |
| -- Otherwise both multi-word, do comparison |
| |
| declare |
| Size : constant Int := N_Digits (Left); |
| Left_Loc : Int; |
| Right_Loc : Int; |
| |
| begin |
| if Size /= N_Digits (Right) then |
| return True; |
| end if; |
| |
| Left_Loc := Uints.Table (Left).Loc; |
| Right_Loc := Uints.Table (Right).Loc; |
| |
| for J in Int_0 .. Size - Int_1 loop |
| if Udigits.Table (Left_Loc + J) /= |
| Udigits.Table (Right_Loc + J) |
| then |
| return True; |
| end if; |
| end loop; |
| |
| return False; |
| end; |
| end UI_Ne; |
| |
| ---------------- |
| -- UI_Negate -- |
| ---------------- |
| |
| function UI_Negate (Right : Valid_Uint) return Valid_Uint is |
| begin |
| -- Case where input is directly represented. Note that since the range |
| -- of Direct values is non-symmetrical, the result may not be directly |
| -- represented, this is taken care of in UI_From_Int. |
| |
| if Direct (Right) then |
| return UI_From_Int (-Direct_Val (Right)); |
| |
| -- Full processing for multi-digit case. Note that we cannot just copy |
| -- the value to the end of the table negating the first digit, since the |
| -- range of Direct values is non-symmetrical, so we can have a negative |
| -- value that is not Direct whose negation can be represented directly. |
| |
| else |
| declare |
| R_Length : constant Int := N_Digits (Right); |
| R_Vec : UI_Vector (1 .. R_Length); |
| Neg : Boolean; |
| |
| begin |
| Init_Operand (Right, R_Vec); |
| Neg := R_Vec (1) > Int_0; |
| R_Vec (1) := abs R_Vec (1); |
| return Vector_To_Uint (R_Vec, Neg); |
| end; |
| end if; |
| end UI_Negate; |
| |
| ------------- |
| -- UI_Rem -- |
| ------------- |
| |
| function UI_Rem (Left : Int; Right : Nonzero_Uint) return Valid_Uint is |
| begin |
| return UI_Rem (UI_From_Int (Left), Right); |
| end UI_Rem; |
| |
| function UI_Rem |
| (Left : Valid_Uint; Right : Nonzero_Int) return Valid_Uint |
| is |
| begin |
| return UI_Rem (Left, UI_From_Int (Right)); |
| end UI_Rem; |
| |
| function UI_Rem |
| (Left : Valid_Uint; Right : Nonzero_Uint) return Valid_Uint |
| is |
| Remainder : Valid_Uint; |
| Ignored_Quotient : Uint; |
| |
| begin |
| pragma Assert (Right /= Uint_0); |
| |
| if Direct (Right) and then Direct (Left) then |
| return UI_From_Int (Direct_Val (Left) rem Direct_Val (Right)); |
| |
| else |
| UI_Div_Rem |
| (Left, Right, Ignored_Quotient, Remainder, |
| Discard_Quotient => True); |
| return Remainder; |
| end if; |
| end UI_Rem; |
| |
| ------------ |
| -- UI_Sub -- |
| ------------ |
| |
| function UI_Sub (Left : Int; Right : Valid_Uint) return Valid_Uint is |
| begin |
| return UI_Add (Left, -Right); |
| end UI_Sub; |
| |
| function UI_Sub (Left : Valid_Uint; Right : Int) return Valid_Uint is |
| begin |
| return UI_Add (Left, -Right); |
| end UI_Sub; |
| |
| function UI_Sub (Left : Valid_Uint; Right : Valid_Uint) return Valid_Uint is |
| begin |
| if Direct (Left) and then Direct (Right) then |
| return UI_From_Int (Direct_Val (Left) - Direct_Val (Right)); |
| else |
| return UI_Add (Left, -Right); |
| end if; |
| end UI_Sub; |
| |
| -------------- |
| -- UI_To_CC -- |
| -------------- |
| |
| function UI_To_CC (Input : Valid_Uint) return Char_Code is |
| begin |
| if Direct (Input) then |
| return Char_Code (Direct_Val (Input)); |
| |
| -- Case of input is more than one digit |
| |
| else |
| declare |
| In_Length : constant Int := N_Digits (Input); |
| In_Vec : UI_Vector (1 .. In_Length); |
| Ret_CC : Char_Code; |
| |
| begin |
| Init_Operand (Input, In_Vec); |
| |
| -- We assume value is positive |
| |
| Ret_CC := 0; |
| for Idx in In_Vec'Range loop |
| Ret_CC := Ret_CC * Char_Code (Base) + |
| Char_Code (abs In_Vec (Idx)); |
| end loop; |
| |
| return Ret_CC; |
| end; |
| end if; |
| end UI_To_CC; |
| |
| --------------- |
| -- UI_To_Int -- |
| --------------- |
| |
| function UI_To_Int (Input : Valid_Uint) return Int is |
| begin |
| if Direct (Input) then |
| return Direct_Val (Input); |
| |
| -- Case of input is more than one digit |
| |
| else |
| declare |
| In_Length : constant Int := N_Digits (Input); |
| In_Vec : UI_Vector (1 .. In_Length); |
| Ret_Int : Int; |
| |
| begin |
| -- Uints of more than one digit could be outside the range for |
| -- Ints. Caller should have checked for this if not certain. |
| -- Constraint_Error to attempt to convert from value outside |
| -- Int'Range. |
| |
| if not UI_Is_In_Int_Range (Input) then |
| raise Constraint_Error; |
| end if; |
| |
| -- Otherwise, proceed ahead, we are OK |
| |
| Init_Operand (Input, In_Vec); |
| Ret_Int := 0; |
| |
| -- Calculate -|Input| and then negates if value is positive. This |
| -- handles our current definition of Int (based on 2s complement). |
| -- Is it secure enough??? |
| |
| for Idx in In_Vec'Range loop |
| Ret_Int := Ret_Int * Base - abs In_Vec (Idx); |
| end loop; |
| |
| if In_Vec (1) < Int_0 then |
| return Ret_Int; |
| else |
| return -Ret_Int; |
| end if; |
| end; |
| end if; |
| end UI_To_Int; |
| |
| ----------------- |
| -- UI_To_Uns64 -- |
| ----------------- |
| |
| function UI_To_Unsigned_64 (Input : Valid_Uint) return Unsigned_64 is |
| begin |
| if Input < Uint_0 then |
| raise Constraint_Error; |
| end if; |
| |
| if Direct (Input) then |
| return Unsigned_64 (Direct_Val (Input)); |
| |
| -- Case of input is more than one digit |
| |
| else |
| if Input >= Uint_2**Int'(64) then |
| raise Constraint_Error; |
| end if; |
| |
| declare |
| In_Length : constant Int := N_Digits (Input); |
| In_Vec : UI_Vector (1 .. In_Length); |
| Ret_Int : Unsigned_64 := 0; |
| |
| begin |
| Init_Operand (Input, In_Vec); |
| |
| for Idx in In_Vec'Range loop |
| Ret_Int := |
| Ret_Int * Unsigned_64 (Base) + Unsigned_64 (In_Vec (Idx)); |
| end loop; |
| |
| return Ret_Int; |
| end; |
| end if; |
| end UI_To_Unsigned_64; |
| |
| -------------- |
| -- UI_Write -- |
| -------------- |
| |
| procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is |
| begin |
| Image_Out (Input, False, Format); |
| end UI_Write; |
| |
| --------------------- |
| -- Vector_To_Uint -- |
| --------------------- |
| |
| function Vector_To_Uint |
| (In_Vec : UI_Vector; |
| Negative : Boolean) return Valid_Uint |
| is |
| Size : Int; |
| Val : Int; |
| |
| begin |
| -- The vector can contain leading zeros. These are not stored in the |
| -- table, so loop through the vector looking for first non-zero digit |
| |
| for J in In_Vec'Range loop |
| if In_Vec (J) /= Int_0 then |
| |
| -- The length of the value is the length of the rest of the vector |
| |
| Size := In_Vec'Last - J + 1; |
| |
| -- One digit value can always be represented directly |
| |
| if Size = Int_1 then |
| if Negative then |
| return Valid_Uint (Int (Uint_Direct_Bias) - In_Vec (J)); |
| else |
| return Valid_Uint (Int (Uint_Direct_Bias) + In_Vec (J)); |
| end if; |
| |
| -- Positive two digit values may be in direct representation range |
| |
| elsif Size = Int_2 and then not Negative then |
| Val := In_Vec (J) * Base + In_Vec (J + 1); |
| |
| if Val <= Max_Direct then |
| return Valid_Uint (Int (Uint_Direct_Bias) + Val); |
| end if; |
| end if; |
| |
| -- The value is outside the direct representation range and must |
| -- therefore be stored in the table. Expand the table to contain |
| -- the count and digits. The index of the new table entry will be |
| -- returned as the result. |
| |
| Uints.Append ((Length => Size, Loc => Udigits.Last + 1)); |
| |
| if Negative then |
| Val := -In_Vec (J); |
| else |
| Val := +In_Vec (J); |
| end if; |
| |
| Udigits.Append (Val); |
| |
| for K in 2 .. Size loop |
| Udigits.Append (In_Vec (J + K - 1)); |
| end loop; |
| |
| return Uints.Last; |
| end if; |
| end loop; |
| |
| -- Dropped through loop only if vector contained all zeros |
| |
| return Uint_0; |
| end Vector_To_Uint; |
| |
| end Uintp; |
