| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- U I N T P -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2014, 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. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- 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 Tree_IO; use Tree_IO; |
| |
| 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 .. 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 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). |
| |
| ---------------------------- |
| -- 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 : 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. The low bound of Vec |
| -- is always 1. |
| |
| 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 irrelevant 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 |
| |
| procedure UI_Div_Rem |
| (Left, Right : 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 (otherwise Quotient is |
| -- set to No_Uint). If Discard_Remainder is False, then the remainder is |
| -- returned in Remainder (otherwise Remainder is set to No_Uint). |
| -- |
| -- If Discard_Quotient is True, Quotient is set to No_Uint |
| -- If Discard_Remainder is True, Remainder is set to No_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; |
| |
| -------------- |
| -- 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 : 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 : constant array (Int range 0 .. 15) of Character := |
| "0123456789ABCDEF"; |
| |
| Q, R : 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 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; |
| |
| 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 : 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 |
| -- 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 (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 : 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 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; |
| |
| --------------- |
| -- 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 : 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 : 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 |
| Quotient : Uint; |
| Remainder : Uint; |
| pragma Warnings (Off, Remainder); |
| begin |
| UI_Div_Rem |
| (Left, Right, |
| Quotient, Remainder, |
| Discard_Remainder => True); |
| return Quotient; |
| end UI_Div; |
| |
| ---------------- |
| -- UI_Div_Rem -- |
| ---------------- |
| |
| procedure UI_Div_Rem |
| (Left, Right : 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); |
| Discard_Int : Int; |
| pragma Warnings (Off, Discard_Int); |
| begin |
| UI_Div_Vector |
| (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last), |
| D, |
| Remainder_V, Discard_Int); |
| 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 : 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_CC -- |
| ---------------- |
| |
| function UI_From_CC (Input : Char_Code) return Uint is |
| begin |
| return UI_From_Int (Int (Input)); |
| end UI_From_CC; |
| |
| ----------------- |
| -- UI_From_Int -- |
| ----------------- |
| |
| function UI_From_Int (Input : Int) return Uint is |
| U : Uint; |
| |
| begin |
| if Min_Direct <= Input and then Input <= Max_Direct then |
| return Uint (Int (Uint_Direct_Bias) + Input); |
| end if; |
| |
| -- If already in the hash table, return entry |
| |
| U := UI_Ints.Get (Input); |
| |
| if U /= No_Uint 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_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 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 |
| |
| -- For constructs such as: |
| -- sqrt_2: constant := 1.41421_35623_73095_04880_16887_24209_698; |
| -- sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2) |
| -- ** long_float'machine_mantissa; |
| -- |
| -- we spend 80% of our 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. On the code above, we |
| -- only get 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 (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 : 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 (Left => Right, 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_Modular_Exponentiation -- |
| ------------------------------- |
| |
| function UI_Modular_Exponentiation |
| (B : Uint; |
| E : Uint; |
| Modulo : Uint) return Uint |
| is |
| M : constant Save_Mark := Mark; |
| |
| Result : Uint := Uint_1; |
| Base : Uint := B; |
| Exponent : 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 : Uint; Modulo : Uint) return Uint is |
| M : constant Save_Mark := Mark; |
| U : Uint; |
| V : Uint; |
| Q : Uint; |
| R : Uint; |
| X : Uint; |
| Y : Uint; |
| T : 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 : 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 |
| -- 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 : 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 |
| Remainder : Uint; |
| Quotient : Uint; |
| pragma Warnings (Off, Quotient); |
| |
| 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, Quotient, Remainder, Discard_Quotient => True); |
| return Remainder; |
| end if; |
| 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_CC -- |
| -------------- |
| |
| function UI_To_CC (Input : 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 : Uint) return Int is |
| pragma Assert (Input /= No_Uint); |
| |
| 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 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; |
