| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- U I N T P -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- $Revision: 1.74 $ |
| -- -- |
| -- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Output; use Output; |
| with Tree_IO; use Tree_IO; |
| |
| 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 .. 64) 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 .. 64) 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. Whenever an |
| -- entry is made in the U_Power 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). |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| function Direct (U : Uint) return Boolean; |
| pragma Inline (Direct); |
| -- Returns True if U is represented directly |
| |
| function Direct_Val (U : Uint) return Int; |
| -- U is a Uint for 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 : 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. |
| |
| function Least_Sig_Digit (Arg : 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 irrelevent as |
| -- long as it is a power of two. |
| |
| procedure Most_Sig_2_Digits |
| (Left : Uint; |
| Right : 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 : Uint) return Int; |
| pragma Inline (N_Digits); |
| -- Returns number of "digits" in a Uint |
| |
| function Sum_Digits (Left : Uint; Sign : Int) return Int; |
| -- If Sign = 1 return the sum of the "digits" of Abs (Left). If the |
| -- total has more then one digit then return Sum_Digits of total. |
| |
| function Sum_Double_Digits (Left : Uint; Sign : Int) return Int; |
| -- Same as above but work in New_Base = Base * Base |
| |
| function Vector_To_Uint |
| (In_Vec : UI_Vector; |
| Negative : Boolean) |
| return 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. |
| |
| ------------ |
| -- Direct -- |
| ------------ |
| |
| function Direct (U : Uint) return Boolean is |
| begin |
| return Int (U) <= Int (Uint_Direct_Last); |
| end Direct; |
| |
| ---------------- |
| -- Direct_Val -- |
| ---------------- |
| |
| function Direct_Val (U : 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; |
| |
| --------------- |
| -- Image_Out -- |
| --------------- |
| |
| procedure Image_Out |
| (Input : Uint; |
| To_Buffer : Boolean; |
| Format : UI_Format) |
| is |
| Marks : constant Uintp.Save_Mark := Uintp.Mark; |
| Base : Uint; |
| Ainput : 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); |
| -- Internal procedure to output one character |
| |
| 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 : Uint); |
| -- Internal procedure to output characters of non-negative Uint |
| |
| ------------------- |
| -- Better_In_Hex -- |
| ------------------- |
| |
| function Better_In_Hex return Boolean is |
| T16 : constant Uint := Uint_2 ** Int'(16); |
| A : 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_Uint -- |
| ---------------- |
| |
| procedure Image_Uint (U : Uint) is |
| H : array (Int range 0 .. 15) of Character := "0123456789ABCDEF"; |
| |
| begin |
| if U >= Base then |
| Image_Uint (U / Base); |
| 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 (U rem Base))); |
| |
| Digs_Output := Digs_Output + 1; |
| end Image_Uint; |
| |
| -- Start of processing for Image_Out |
| |
| begin |
| if Input = No_Uint then |
| Image_Char ('?'); |
| 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 : Uint; Vec : out UI_Vector) is |
| Loc : Int; |
| |
| 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; |
| |
| end Initialize; |
| |
| --------------------- |
| -- Least_Sig_Digit -- |
| --------------------- |
| |
| function Least_Sig_Digit (Arg : 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 : Uint; |
| Right : Uint; |
| Left_Hat : out Int; |
| Right_Hat : out Int) |
| is |
| begin |
| pragma Assert (Left >= Right); |
| |
| if Direct (Left) then |
| 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 (Left); |
| 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 -- |
| --------------- |
| |
| -- Note: N_Digits returns 1 for No_Uint |
| |
| function N_Digits (Input : 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 : Uint) return Nat is |
| Bits : Nat; |
| Num : Nat; |
| |
| begin |
| if UI_Is_In_Int_Range (Input) then |
| Num := UI_To_Int (Input); |
| Bits := 0; |
| |
| else |
| Bits := Base_Bits * (Uints.Table (Input).Length - 1); |
| Num := abs (Udigits.Table (Uints.Table (Input).Loc)); |
| end if; |
| |
| 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 (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 Uint) is |
| begin |
| if Direct (UI) then |
| Release (M); |
| |
| else |
| declare |
| UE_Len : Pos := Uints.Table (UI).Length; |
| UE_Loc : Int := Uints.Table (UI).Loc; |
| |
| UD : Udigits.Table_Type (1 .. UE_Len) := |
| Udigits.Table (UE_Loc .. UE_Loc + UE_Len - 1); |
| |
| begin |
| Release (M); |
| |
| Uints.Increment_Last; |
| UI := Uints.Last; |
| |
| Uints.Table (UI) := (UE_Len, Udigits.Last + 1); |
| |
| for J in 1 .. UE_Len loop |
| Udigits.Increment_Last; |
| Udigits.Table (Udigits.Last) := UD (J); |
| end loop; |
| end; |
| end if; |
| end Release_And_Save; |
| |
| procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out 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 : Pos := Uints.Table (UI1).Length; |
| UE1_Loc : Int := Uints.Table (UI1).Loc; |
| |
| UD1 : Udigits.Table_Type (1 .. UE1_Len) := |
| Udigits.Table (UE1_Loc .. UE1_Loc + UE1_Len - 1); |
| |
| UE2_Len : Pos := Uints.Table (UI2).Length; |
| UE2_Loc : Int := Uints.Table (UI2).Loc; |
| |
| UD2 : Udigits.Table_Type (1 .. UE2_Len) := |
| Udigits.Table (UE2_Loc .. UE2_Loc + UE2_Len - 1); |
| |
| begin |
| Release (M); |
| |
| Uints.Increment_Last; |
| UI1 := Uints.Last; |
| |
| Uints.Table (UI1) := (UE1_Len, Udigits.Last + 1); |
| |
| for J in 1 .. UE1_Len loop |
| Udigits.Increment_Last; |
| Udigits.Table (Udigits.Last) := UD1 (J); |
| end loop; |
| |
| Uints.Increment_Last; |
| UI2 := Uints.Last; |
| |
| Uints.Table (UI2) := (UE2_Len, Udigits.Last + 1); |
| |
| for J in 1 .. UE2_Len loop |
| Udigits.Increment_Last; |
| Udigits.Table (Udigits.Last) := UD2 (J); |
| end loop; |
| end; |
| end if; |
| end Release_And_Save; |
| |
| ---------------- |
| -- Sum_Digits -- |
| ---------------- |
| |
| -- This is done in one pass |
| |
| -- Mathematically: assume base congruent to 1 and compute an equivelent |
| -- integer to Left. |
| |
| -- If Sign = -1 return the alternating sum of the "digits". |
| |
| -- D1 - D2 + D3 - D4 + D5 . . . |
| |
| -- (where D1 is Least Significant Digit) |
| |
| -- Mathematically: assume base congruent to -1 and compute an equivelent |
| -- integer to Left. |
| |
| -- This is used in Rem and Base is assumed to be 2 ** 15 |
| |
| -- Note: The next two functions are very similar, any style changes made |
| -- to one should be reflected in both. These would be simpler if we |
| -- worked base 2 ** 32. |
| |
| function Sum_Digits (Left : Uint; Sign : Int) return Int is |
| begin |
| pragma Assert (Sign = Int_1 or Sign = Int (-1)); |
| |
| -- First try simple case; |
| |
| if Direct (Left) then |
| declare |
| Tmp_Int : Int := Direct_Val (Left); |
| |
| begin |
| if Tmp_Int >= Base then |
| Tmp_Int := (Tmp_Int / Base) + |
| Sign * (Tmp_Int rem Base); |
| |
| -- Now Tmp_Int is in [-(Base - 1) .. 2 * (Base - 1)] |
| |
| if Tmp_Int >= Base then |
| |
| -- Sign must be 1. |
| |
| Tmp_Int := (Tmp_Int / Base) + 1; |
| |
| end if; |
| |
| -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)] |
| |
| end if; |
| |
| return Tmp_Int; |
| end; |
| |
| -- Otherwise full circuit is needed |
| |
| else |
| declare |
| L_Length : Int := N_Digits (Left); |
| L_Vec : UI_Vector (1 .. L_Length); |
| Tmp_Int : Int; |
| Carry : Int; |
| Alt : Int; |
| |
| begin |
| Init_Operand (Left, L_Vec); |
| L_Vec (1) := abs L_Vec (1); |
| Tmp_Int := 0; |
| Carry := 0; |
| Alt := 1; |
| |
| for J in reverse 1 .. L_Length loop |
| Tmp_Int := Tmp_Int + Alt * (L_Vec (J) + Carry); |
| |
| -- Tmp_Int is now between [-2 * Base + 1 .. 2 * Base - 1], |
| -- since old Tmp_Int is between [-(Base - 1) .. Base - 1] |
| -- and L_Vec is in [0 .. Base - 1] and Carry in [-1 .. 1] |
| |
| if Tmp_Int >= Base then |
| Tmp_Int := Tmp_Int - Base; |
| Carry := 1; |
| |
| elsif Tmp_Int <= -Base then |
| Tmp_Int := Tmp_Int + Base; |
| Carry := -1; |
| |
| else |
| Carry := 0; |
| end if; |
| |
| -- Tmp_Int is now between [-Base + 1 .. Base - 1] |
| |
| Alt := Alt * Sign; |
| end loop; |
| |
| Tmp_Int := Tmp_Int + Alt * Carry; |
| |
| -- Tmp_Int is now between [-Base .. Base] |
| |
| if Tmp_Int >= Base then |
| Tmp_Int := Tmp_Int - Base + Alt * Sign * 1; |
| |
| elsif Tmp_Int <= -Base then |
| Tmp_Int := Tmp_Int + Base + Alt * Sign * (-1); |
| end if; |
| |
| -- Now Tmp_Int is in [-(Base - 1) .. (Base - 1)] |
| |
| return Tmp_Int; |
| end; |
| end if; |
| end Sum_Digits; |
| |
| ----------------------- |
| -- Sum_Double_Digits -- |
| ----------------------- |
| |
| -- Note: This is used in Rem, Base is assumed to be 2 ** 15 |
| |
| function Sum_Double_Digits (Left : Uint; Sign : Int) return Int is |
| begin |
| -- First try simple case; |
| |
| pragma Assert (Sign = Int_1 or Sign = Int (-1)); |
| |
| if Direct (Left) then |
| return Direct_Val (Left); |
| |
| -- Otherwise full circuit is needed |
| |
| else |
| declare |
| L_Length : Int := N_Digits (Left); |
| L_Vec : UI_Vector (1 .. L_Length); |
| Most_Sig_Int : Int; |
| Least_Sig_Int : Int; |
| Carry : Int; |
| J : Int; |
| Alt : Int; |
| |
| begin |
| Init_Operand (Left, L_Vec); |
| L_Vec (1) := abs L_Vec (1); |
| Most_Sig_Int := 0; |
| Least_Sig_Int := 0; |
| Carry := 0; |
| Alt := 1; |
| J := L_Length; |
| |
| while J > Int_1 loop |
| |
| Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry); |
| |
| -- Least is in [-2 Base + 1 .. 2 * Base - 1] |
| -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1] |
| -- and old Least in [-Base + 1 .. Base - 1] |
| |
| if Least_Sig_Int >= Base then |
| Least_Sig_Int := Least_Sig_Int - Base; |
| Carry := 1; |
| |
| elsif Least_Sig_Int <= -Base then |
| Least_Sig_Int := Least_Sig_Int + Base; |
| Carry := -1; |
| |
| else |
| Carry := 0; |
| end if; |
| |
| -- Least is now in [-Base + 1 .. Base - 1] |
| |
| Most_Sig_Int := Most_Sig_Int + Alt * (L_Vec (J - 1) + Carry); |
| |
| -- Most is in [-2 Base + 1 .. 2 * Base - 1] |
| -- Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1] |
| -- and old Most in [-Base + 1 .. Base - 1] |
| |
| if Most_Sig_Int >= Base then |
| Most_Sig_Int := Most_Sig_Int - Base; |
| Carry := 1; |
| |
| elsif Most_Sig_Int <= -Base then |
| Most_Sig_Int := Most_Sig_Int + Base; |
| Carry := -1; |
| else |
| Carry := 0; |
| end if; |
| |
| -- Most is now in [-Base + 1 .. Base - 1] |
| |
| J := J - 2; |
| Alt := Alt * Sign; |
| end loop; |
| |
| if J = Int_1 then |
| Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry); |
| else |
| Least_Sig_Int := Least_Sig_Int + Alt * Carry; |
| end if; |
| |
| if Least_Sig_Int >= Base then |
| Least_Sig_Int := Least_Sig_Int - Base; |
| Most_Sig_Int := Most_Sig_Int + Alt * 1; |
| |
| elsif Least_Sig_Int <= -Base then |
| Least_Sig_Int := Least_Sig_Int + Base; |
| Most_Sig_Int := Most_Sig_Int + Alt * (-1); |
| end if; |
| |
| if Most_Sig_Int >= Base then |
| Most_Sig_Int := Most_Sig_Int - Base; |
| Alt := Alt * Sign; |
| Least_Sig_Int := |
| Least_Sig_Int + Alt * 1; -- cannot overflow again |
| |
| elsif Most_Sig_Int <= -Base then |
| Most_Sig_Int := Most_Sig_Int + Base; |
| Alt := Alt * Sign; |
| Least_Sig_Int := |
| Least_Sig_Int + Alt * (-1); -- cannot overflow again. |
| end if; |
| |
| return Most_Sig_Int * Base + Least_Sig_Int; |
| end; |
| end if; |
| end Sum_Double_Digits; |
| |
| --------------- |
| -- Tree_Read -- |
| --------------- |
| |
| procedure Tree_Read is |
| begin |
| Uints.Tree_Read; |
| Udigits.Tree_Read; |
| |
| Tree_Read_Int (Int (Uint_Int_First)); |
| Tree_Read_Int (Int (Uint_Int_Last)); |
| Tree_Read_Int (UI_Power_2_Set); |
| Tree_Read_Int (UI_Power_10_Set); |
| Tree_Read_Int (Int (Uints_Min)); |
| Tree_Read_Int (Udigits_Min); |
| |
| for J in 0 .. UI_Power_2_Set loop |
| Tree_Read_Int (Int (UI_Power_2 (J))); |
| end loop; |
| |
| for J in 0 .. UI_Power_10_Set loop |
| Tree_Read_Int (Int (UI_Power_10 (J))); |
| end loop; |
| |
| end Tree_Read; |
| |
| ---------------- |
| -- Tree_Write -- |
| ---------------- |
| |
| procedure Tree_Write is |
| begin |
| Uints.Tree_Write; |
| Udigits.Tree_Write; |
| |
| Tree_Write_Int (Int (Uint_Int_First)); |
| Tree_Write_Int (Int (Uint_Int_Last)); |
| Tree_Write_Int (UI_Power_2_Set); |
| Tree_Write_Int (UI_Power_10_Set); |
| Tree_Write_Int (Int (Uints_Min)); |
| Tree_Write_Int (Udigits_Min); |
| |
| for J in 0 .. UI_Power_2_Set loop |
| Tree_Write_Int (Int (UI_Power_2 (J))); |
| end loop; |
| |
| for J in 0 .. UI_Power_10_Set loop |
| Tree_Write_Int (Int (UI_Power_10 (J))); |
| end loop; |
| |
| end Tree_Write; |
| |
| ------------- |
| -- UI_Abs -- |
| ------------- |
| |
| function UI_Abs (Right : Uint) return Uint 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 : Uint) return Uint is |
| begin |
| return UI_Add (UI_From_Int (Left), Right); |
| end UI_Add; |
| |
| function UI_Add (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Add (Left, UI_From_Int (Right)); |
| end UI_Add; |
| |
| function UI_Add (Left : Uint; Right : Uint) return Uint is |
| begin |
| -- 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 : Int := N_Digits (Left); |
| R_Length : 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 : 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 : 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 : Uint) return Uint is |
| begin |
| return UI_Div (UI_From_Int (Left), Right); |
| end UI_Div; |
| |
| function UI_Div (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Div (Left, UI_From_Int (Right)); |
| end UI_Div; |
| |
| function UI_Div (Left, Right : Uint) return Uint is |
| begin |
| pragma Assert (Right /= Uint_0); |
| |
| -- Cases where both operands are represented directly |
| |
| if Direct (Left) and then Direct (Right) then |
| return UI_From_Int (Direct_Val (Left) / Direct_Val (Right)); |
| 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 : Int; |
| Tmp_Divisor : Int; |
| Carry : Int; |
| Tmp_Int : Int; |
| Tmp_Dig : Int; |
| |
| begin |
| -- Result is zero if left operand is shorter than right |
| |
| if L_Length < R_Length then |
| return Uint_0; |
| 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 |
| Remainder := 0; |
| Tmp_Divisor := abs R_Vec (1); |
| |
| declare |
| Quotient : UI_Vector (1 .. L_Length); |
| |
| begin |
| for J in L_Vec'Range loop |
| Tmp_Int := Remainder * Base + abs L_Vec (J); |
| Quotient (J) := Tmp_Int / Tmp_Divisor; |
| Remainder := Tmp_Int rem Tmp_Divisor; |
| end loop; |
| |
| return |
| Vector_To_Uint |
| (Quotient, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0)); |
| 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 : UI_Vector (1 .. Q_Length); |
| Divisor_Dig1 : Int; |
| Divisor_Dig2 : Int; |
| Q_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'Range loop |
| |
| -- [ CALCULATE Q (hat) ] (step D3 in the algorithm). |
| |
| Tmp_Int := Dividend (J) * Base + Dividend (J + 1); |
| |
| -- Initial guess |
| |
| if Dividend (J) = Divisor_Dig1 then |
| Q_Guess := Base - 1; |
| else |
| Q_Guess := Tmp_Int / Divisor_Dig1; |
| end if; |
| |
| -- Refine the guess |
| |
| while Divisor_Dig2 * Q_Guess > |
| (Tmp_Int - Q_Guess * Divisor_Dig1) * Base + |
| Dividend (J + 2) |
| loop |
| Q_Guess := Q_Guess - 1; |
| 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 (J) := Q_Guess; |
| end loop; |
| |
| return Vector_To_Uint |
| (Quotient, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0)); |
| |
| end Algorithm_D; |
| end; |
| end UI_Div; |
| |
| ------------ |
| -- UI_Eq -- |
| ------------ |
| |
| function UI_Eq (Left : Int; Right : Uint) return Boolean is |
| begin |
| return not UI_Ne (UI_From_Int (Left), Right); |
| end UI_Eq; |
| |
| function UI_Eq (Left : Uint; Right : Int) return Boolean is |
| begin |
| return not UI_Ne (Left, UI_From_Int (Right)); |
| end UI_Eq; |
| |
| function UI_Eq (Left : Uint; Right : Uint) return Boolean is |
| begin |
| return not UI_Ne (Left, Right); |
| end UI_Eq; |
| |
| -------------- |
| -- UI_Expon -- |
| -------------- |
| |
| function UI_Expon (Left : Int; Right : Uint) return Uint is |
| begin |
| return UI_Expon (UI_From_Int (Left), Right); |
| end UI_Expon; |
| |
| function UI_Expon (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Expon (Left, UI_From_Int (Right)); |
| end UI_Expon; |
| |
| function UI_Expon (Left : Int; Right : Int) return Uint is |
| begin |
| return UI_Expon (UI_From_Int (Left), UI_From_Int (Right)); |
| end UI_Expon; |
| |
| function UI_Expon (Left : Uint; Right : Uint) return 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_64 then |
| |
| -- 2 ** N for N in 2 .. 64 |
| |
| 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 .. 64 |
| |
| 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 : Uint := Right; |
| Squares : Uint := Left; |
| Result : 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_Dint -- |
| ------------------ |
| |
| function UI_From_Dint (Input : Dint) return Uint is |
| begin |
| |
| if Dint (Min_Direct) <= Input and then Input <= Dint (Max_Direct) then |
| return Uint (Dint (Uint_Direct_Bias) + Input); |
| |
| -- For values of larger magnitude, compute digits into a vector and |
| -- call Vector_To_Uint. |
| |
| else |
| declare |
| Max_For_Dint : constant := 5; |
| -- Base is defined so that 5 Uint digits is sufficient |
| -- to hold the largest possible Dint value. |
| |
| V : UI_Vector (1 .. Max_For_Dint); |
| |
| Temp_Integer : Dint; |
| |
| begin |
| for J in V'Range loop |
| V (J) := 0; |
| end loop; |
| |
| Temp_Integer := Input; |
| |
| for J in reverse V'Range loop |
| V (J) := Int (abs (Temp_Integer rem Dint (Base))); |
| Temp_Integer := Temp_Integer / Dint (Base); |
| end loop; |
| |
| return Vector_To_Uint (V, Input < Dint'(0)); |
| end; |
| end if; |
| end UI_From_Dint; |
| |
| ----------------- |
| -- UI_From_Int -- |
| ----------------- |
| |
| function UI_From_Int (Input : Int) return Uint is |
| begin |
| |
| if Min_Direct <= Input and then Input <= Max_Direct then |
| return Uint (Int (Uint_Direct_Bias) + Input); |
| |
| -- For values of larger magnitude, compute digits into a vector and |
| -- call Vector_To_Uint. |
| |
| else |
| 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; |
| |
| begin |
| for J in V'Range loop |
| V (J) := 0; |
| end loop; |
| |
| Temp_Integer := Input; |
| |
| for J in reverse V'Range loop |
| V (J) := abs (Temp_Integer rem Base); |
| Temp_Integer := Temp_Integer / Base; |
| end loop; |
| |
| return Vector_To_Uint (V, Input < Int_0); |
| end; |
| end if; |
| end UI_From_Int; |
| |
| ------------ |
| -- 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 : Uint) return Uint is |
| U, V : 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 : 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 can not take the single precision step |
| |
| Den1 := V_Hat + C; |
| Den2 := V_Hat + D; |
| exit when (Den1 * 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. |
| |
| -- Fixed bug 1415-008 spends 80% of its time working on this |
| -- step. Perhaps we need a special case Int / Uint dot |
| -- product to speed things up. ??? |
| |
| -- Alternatively we could increase the single precision |
| -- iterations to handle Uint's of some small size ( <5 |
| -- digits?). Then we would have more iterations on small Uint. |
| -- Fixed bug 1415-008 only gets 5 (on average) single |
| -- precision iterations per large iteration. ??? |
| |
| 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 : Uint) return Boolean is |
| begin |
| return not UI_Lt (UI_From_Int (Left), Right); |
| end UI_Ge; |
| |
| function UI_Ge (Left : Uint; Right : Int) return Boolean is |
| begin |
| return not UI_Lt (Left, UI_From_Int (Right)); |
| end UI_Ge; |
| |
| function UI_Ge (Left : Uint; Right : Uint) return Boolean is |
| begin |
| return not UI_Lt (Left, Right); |
| end UI_Ge; |
| |
| ------------ |
| -- UI_Gt -- |
| ------------ |
| |
| function UI_Gt (Left : Int; Right : Uint) return Boolean is |
| begin |
| return UI_Lt (Right, UI_From_Int (Left)); |
| end UI_Gt; |
| |
| function UI_Gt (Left : Uint; Right : Int) return Boolean is |
| begin |
| return UI_Lt (UI_From_Int (Right), Left); |
| end UI_Gt; |
| |
| function UI_Gt (Left : Uint; Right : Uint) return Boolean is |
| begin |
| return UI_Lt (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; |
| |
| ------------------------- |
| -- UI_Is_In_Int_Range -- |
| ------------------------- |
| |
| function UI_Is_In_Int_Range (Input : Uint) return Boolean is |
| 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 : Uint) return Boolean is |
| begin |
| return not UI_Lt (Right, UI_From_Int (Left)); |
| end UI_Le; |
| |
| function UI_Le (Left : Uint; Right : Int) return Boolean is |
| begin |
| return not UI_Lt (UI_From_Int (Right), Left); |
| end UI_Le; |
| |
| function UI_Le (Left : Uint; Right : Uint) return Boolean is |
| begin |
| return not UI_Lt (Right, Left); |
| end UI_Le; |
| |
| ------------ |
| -- UI_Lt -- |
| ------------ |
| |
| function UI_Lt (Left : Int; Right : Uint) return Boolean is |
| begin |
| return UI_Lt (UI_From_Int (Left), Right); |
| end UI_Lt; |
| |
| function UI_Lt (Left : Uint; Right : Int) return Boolean is |
| begin |
| return UI_Lt (Left, UI_From_Int (Right)); |
| end UI_Lt; |
| |
| function UI_Lt (Left : Uint; Right : Uint) return Boolean is |
| begin |
| -- 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 : Uint) return Uint is |
| begin |
| return UI_Max (UI_From_Int (Left), Right); |
| end UI_Max; |
| |
| function UI_Max (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Max (Left, UI_From_Int (Right)); |
| end UI_Max; |
| |
| function UI_Max (Left : Uint; Right : Uint) return 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 : Uint) return Uint is |
| begin |
| return UI_Min (UI_From_Int (Left), Right); |
| end UI_Min; |
| |
| function UI_Min (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Min (Left, UI_From_Int (Right)); |
| end UI_Min; |
| |
| function UI_Min (Left : Uint; Right : Uint) return 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 : Uint) return Uint is |
| begin |
| return UI_Mod (UI_From_Int (Left), Right); |
| end UI_Mod; |
| |
| function UI_Mod (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Mod (Left, UI_From_Int (Right)); |
| end UI_Mod; |
| |
| function UI_Mod (Left : Uint; Right : Uint) return Uint is |
| Urem : constant 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_Mul -- |
| ------------ |
| |
| function UI_Mul (Left : Int; Right : Uint) return Uint is |
| begin |
| return UI_Mul (UI_From_Int (Left), Right); |
| end UI_Mul; |
| |
| function UI_Mul (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Mul (Left, UI_From_Int (Right)); |
| end UI_Mul; |
| |
| function UI_Mul (Left : Uint; Right : Uint) return Uint is |
| begin |
| -- Simple case of single length operands |
| |
| if Direct (Left) and then Direct (Right) then |
| return |
| UI_From_Dint |
| (Dint (Direct_Val (Left)) * Dint (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 : Uint) return Boolean is |
| begin |
| return UI_Ne (UI_From_Int (Left), Right); |
| end UI_Ne; |
| |
| function UI_Ne (Left : Uint; Right : Int) return Boolean is |
| begin |
| return UI_Ne (Left, UI_From_Int (Right)); |
| end UI_Ne; |
| |
| function UI_Ne (Left : Uint; Right : Uint) return Boolean is |
| begin |
| -- Quick processing for identical arguments. Note that this takes |
| -- care of the case of two No_Uint 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 : Uint) return 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 : Uint) return Uint is |
| begin |
| return UI_Rem (UI_From_Int (Left), Right); |
| end UI_Rem; |
| |
| function UI_Rem (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Rem (Left, UI_From_Int (Right)); |
| end UI_Rem; |
| |
| function UI_Rem (Left, Right : Uint) return Uint is |
| Sign : Int; |
| Tmp : Int; |
| |
| subtype Int1_12 is Integer range 1 .. 12; |
| |
| begin |
| pragma Assert (Right /= Uint_0); |
| |
| if Direct (Right) then |
| if Direct (Left) then |
| return UI_From_Int (Direct_Val (Left) rem Direct_Val (Right)); |
| |
| else |
| -- Special cases when Right is less than 13 and Left is larger |
| -- larger than one digit. All of these algorithms depend on the |
| -- base being 2 ** 15 We work with Abs (Left) and Abs(Right) |
| -- then multiply result by Sign (Left) |
| |
| if (Right <= Uint_12) and then (Right >= Uint_Minus_12) then |
| |
| if (Left < Uint_0) then |
| Sign := -1; |
| else |
| Sign := 1; |
| end if; |
| |
| -- All cases are listed, grouped by mathematical method |
| -- It is not inefficient to do have this case list out |
| -- of order since GCC sorts the cases we list. |
| |
| case Int1_12 (abs (Direct_Val (Right))) is |
| |
| when 1 => |
| return Uint_0; |
| |
| -- Powers of two are simple AND's with LS Left Digit |
| -- GCC will recognise these constants as powers of 2 |
| -- and replace the rem with simpler operations where |
| -- possible. |
| |
| -- Least_Sig_Digit might return Negative numbers. |
| |
| when 2 => |
| return UI_From_Int ( |
| Sign * (Least_Sig_Digit (Left) mod 2)); |
| |
| when 4 => |
| return UI_From_Int ( |
| Sign * (Least_Sig_Digit (Left) mod 4)); |
| |
| when 8 => |
| return UI_From_Int ( |
| Sign * (Least_Sig_Digit (Left) mod 8)); |
| |
| -- Some number theoretical tricks: |
| |
| -- If B Rem Right = 1 then |
| -- Left Rem Right = Sum_Of_Digits_Base_B (Left) Rem Right |
| |
| -- Note: 2^32 mod 3 = 1 |
| |
| when 3 => |
| return UI_From_Int ( |
| Sign * (Sum_Double_Digits (Left, 1) rem Int (3))); |
| |
| -- Note: 2^15 mod 7 = 1 |
| |
| when 7 => |
| return UI_From_Int ( |
| Sign * (Sum_Digits (Left, 1) rem Int (7))); |
| |
| -- Note: 2^32 mod 5 = -1 |
| -- Alternating sums might be negative, but rem is always |
| -- positive hence we must use mod here. |
| |
| when 5 => |
| Tmp := Sum_Double_Digits (Left, -1) mod Int (5); |
| return UI_From_Int (Sign * Tmp); |
| |
| -- Note: 2^15 mod 9 = -1 |
| -- Alternating sums might be negative, but rem is always |
| -- positive hence we must use mod here. |
| |
| when 9 => |
| Tmp := Sum_Digits (Left, -1) mod Int (9); |
| return UI_From_Int (Sign * Tmp); |
| |
| -- Note: 2^15 mod 11 = -1 |
| -- Alternating sums might be negative, but rem is always |
| -- positive hence we must use mod here. |
| |
| when 11 => |
| Tmp := Sum_Digits (Left, -1) mod Int (11); |
| return UI_From_Int (Sign * Tmp); |
| |
| -- Now resort to Chinese Remainder theorem |
| -- to reduce 6, 10, 12 to previous special cases |
| |
| -- There is no reason we could not add more cases |
| -- like these if it proves useful. |
| |
| -- Perhaps we should go up to 16, however |
| -- I have no "trick" for 13. |
| |
| -- To find u mod m we: |
| -- Pick m1, m2 S.T. |
| -- GCD(m1, m2) = 1 AND m = (m1 * m2). |
| -- Next we pick (Basis) M1, M2 small S.T. |
| -- (M1 mod m1) = (M2 mod m2) = 1 AND |
| -- (M1 mod m2) = (M2 mod m1) = 0 |
| |
| -- So u mod m = (u1 * M1 + u2 * M2) mod m |
| -- Where u1 = (u mod m1) AND u2 = (u mod m2); |
| -- Under typical circumstances the last mod m |
| -- can be done with a (possible) single subtraction. |
| |
| -- m1 = 2; m2 = 3; M1 = 3; M2 = 4; |
| |
| when 6 => |
| Tmp := 3 * (Least_Sig_Digit (Left) rem 2) + |
| 4 * (Sum_Double_Digits (Left, 1) rem 3); |
| return UI_From_Int (Sign * (Tmp rem 6)); |
| |
| -- m1 = 2; m2 = 5; M1 = 5; M2 = 6; |
| |
| when 10 => |
| Tmp := 5 * (Least_Sig_Digit (Left) rem 2) + |
| 6 * (Sum_Double_Digits (Left, -1) mod 5); |
| return UI_From_Int (Sign * (Tmp rem 10)); |
| |
| -- m1 = 3; m2 = 4; M1 = 4; M2 = 9; |
| |
| when 12 => |
| Tmp := 4 * (Sum_Double_Digits (Left, 1) rem 3) + |
| 9 * (Least_Sig_Digit (Left) rem 4); |
| return UI_From_Int (Sign * (Tmp rem 12)); |
| end case; |
| |
| end if; |
| |
| -- Else fall through to general case. |
| |
| -- ???This needs to be improved. We have the Rem when we do the |
| -- Div. Div throws it away! |
| |
| -- The special case Length (Left) = Length(right) = 1 in Div |
| -- looks slow. It uses UI_To_Int when Int should suffice. ??? |
| end if; |
| end if; |
| |
| return Left - (Left / Right) * Right; |
| end UI_Rem; |
| |
| ------------ |
| -- UI_Sub -- |
| ------------ |
| |
| function UI_Sub (Left : Int; Right : Uint) return Uint is |
| begin |
| return UI_Add (Left, -Right); |
| end UI_Sub; |
| |
| function UI_Sub (Left : Uint; Right : Int) return Uint is |
| begin |
| return UI_Add (Left, -Right); |
| end UI_Sub; |
| |
| function UI_Sub (Left : Uint; Right : Uint) return 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_Int -- |
| ---------------- |
| |
| function UI_To_Int (Input : 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. |
| -- Fatal error to attempt to convert from value outside Int'Range. |
| |
| pragma Assert (UI_Is_In_Int_Range (Input)); |
| |
| -- 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_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 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 Uint (Int (Uint_Direct_Bias) - In_Vec (J)); |
| else |
| return 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 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 tigis. The index of the new table |
| -- entry will be returned as the result. |
| |
| Uints.Increment_Last; |
| Uints.Table (Uints.Last).Length := Size; |
| Uints.Table (Uints.Last).Loc := Udigits.Last + 1; |
| |
| Udigits.Increment_Last; |
| |
| if Negative then |
| Udigits.Table (Udigits.Last) := -In_Vec (J); |
| else |
| Udigits.Table (Udigits.Last) := +In_Vec (J); |
| end if; |
| |
| for K in 2 .. Size loop |
| Udigits.Increment_Last; |
| Udigits.Table (Udigits.Last) := 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; |
