with Output; use Output;
with Tree_IO; use Tree_IO;
with GNAT.HTable; use GNAT.HTable;
package body Uintp is
Uint_Int_First : Uint := Uint_0;
Uint_Int_Last : Uint;
UI_Power_2 : array (Int range 0 .. 64) of Uint;
UI_Power_2_Set : Nat;
UI_Power_10 : array (Int range 0 .. 64) of Uint;
UI_Power_10_Set : Nat;
Uints_Min : Uint;
Udigits_Min : Int;
Int_0 : constant Int := 0;
Int_1 : constant Int := 1;
Int_2 : constant Int := 2;
subtype Hnum is Nat range 0 .. 1022;
function Hash_Num (F : Int) return Hnum;
package UI_Ints is new Simple_HTable (
Header_Num => Hnum,
Element => Uint,
No_Element => No_Uint,
Key => Int,
Hash => Hash_Num,
Equal => "=");
function Direct (U : Uint) return Boolean;
pragma Inline (Direct);
function Direct_Val (U : Uint) return Int;
function GCD (Jin, Kin : Int) return Int;
procedure Image_Out
(Input : Uint;
To_Buffer : Boolean;
Format : UI_Format);
procedure Init_Operand (UI : Uint; Vec : out UI_Vector);
pragma Inline (Init_Operand);
function Least_Sig_Digit (Arg : Uint) return Int;
pragma Inline (Least_Sig_Digit);
procedure Most_Sig_2_Digits
(Left : Uint;
Right : Uint;
Left_Hat : out Int;
Right_Hat : out Int);
function N_Digits (Input : Uint) return Int;
pragma Inline (N_Digits);
function Sum_Digits (Left : Uint; Sign : Int) return Int;
function Sum_Double_Digits (Left : Uint; Sign : Int) return Int;
function Vector_To_Uint
(In_Vec : UI_Vector;
Negative : Boolean)
return Uint;
function Direct (U : Uint) return Boolean is
begin
return Int (U) <= Int (Uint_Direct_Last);
end Direct;
function Direct_Val (U : Uint) return Int is
begin
pragma Assert (Direct (U));
return Int (U) - Int (Uint_Direct_Bias);
end Direct_Val;
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;
function Hash_Num (F : Int) return Hnum is
begin
return Standard."mod" (F, Hnum'Range_Length);
end Hash_Num;
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;
Exponent : Natural := 0;
function Better_In_Hex return Boolean;
procedure Image_Char (C : Character);
procedure Image_Exponent (N : Natural);
procedure Image_Uint (U : Uint);
function Better_In_Hex return Boolean is
T16 : constant Uint := Uint_2 ** Int'(16);
A : Uint;
begin
A := UI_Abs (Input);
if A < T16 then
return False;
end if;
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;
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;
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;
procedure Image_Uint (U : Uint) is
H : constant 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;
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;
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;
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;
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;
return V;
else
return
Udigits.Table
(Uints.Table (Arg).Loc + Uints.Table (Arg).Length - 1);
end if;
end Least_Sig_Digit;
function Mark return Save_Mark is
begin
return (Save_Uint => Uints.Last, Save_Udigit => Udigits.Last);
end Mark;
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
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;
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;
function Num_Bits (Input : Uint) return Nat is
Bits : Nat;
Num : Nat;
begin
if UI_Is_In_Int_Range (Input) then
Num := abs (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;
procedure pid (Input : Uint) is
begin
UI_Write (Input, Decimal);
Write_Eol;
end pid;
procedure pih (Input : Uint) is
begin
UI_Write (Input, Hex);
Write_Eol;
end pih;
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;
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.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 : 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.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;
function Sum_Digits (Left : Uint; Sign : Int) return Int is
begin
pragma Assert (Sign = Int_1 or Sign = Int (-1));
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);
if Tmp_Int >= Base then
Tmp_Int := (Tmp_Int / Base) + 1;
end if;
end if;
return Tmp_Int;
end;
else
declare
L_Length : constant 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);
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;
Alt := Alt * Sign;
end loop;
Tmp_Int := Tmp_Int + Alt * Carry;
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;
return Tmp_Int;
end;
end if;
end Sum_Digits;
function Sum_Double_Digits (Left : Uint; Sign : Int) return Int is
begin
pragma Assert (Sign = Int_1 or Sign = Int (-1));
if Direct (Left) then
return Direct_Val (Left);
else
declare
L_Length : constant 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);
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;
Most_Sig_Int := Most_Sig_Int + Alt * (L_Vec (J - 1) + Carry);
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;
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;
elsif Most_Sig_Int <= -Base then
Most_Sig_Int := Most_Sig_Int + Base;
Alt := Alt * Sign;
Least_Sig_Int :=
Least_Sig_Int + Alt * (-1); end if;
return Most_Sig_Int * Base + Least_Sig_Int;
end;
end if;
end Sum_Double_Digits;
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;
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;
function UI_Abs (Right : Uint) return Uint is
begin
if Right < Uint_0 then
return -Right;
else
return Right;
end if;
end UI_Abs;
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
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;
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);
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;
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
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
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;
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;
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;
function UI_Decimal_Digits_Hi (U : Uint) return Nat is
begin
return 5 * N_Digits (U);
end UI_Decimal_Digits_Hi;
function UI_Decimal_Digits_Lo (U : Uint) return Nat is
begin
return 1 + 4 * (N_Digits (U) - 1);
end UI_Decimal_Digits_Lo;
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);
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
if L_Length < R_Length then
return Uint_0;
end if;
Init_Operand (Left, L_Vec);
Init_Operand (Right, R_Vec);
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;
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
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
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;
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;
Divisor_Dig1 := Divisor (1);
Divisor_Dig2 := Divisor (2);
for J in Quotient'Range loop
Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
if Dividend (J) = Divisor_Dig1 then
Q_Guess := Base - 1;
else
Q_Guess := Tmp_Int / Divisor_Dig1;
end if;
while Divisor_Dig2 * Q_Guess >
(Tmp_Int - Q_Guess * Divisor_Dig1) * Base +
Dividend (J + 2)
loop
Q_Guess := Q_Guess - 1;
end loop;
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;
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;
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;
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;
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);
if Right = Uint_0 then
return Uint_1;
elsif Left = Uint_0 then
return Uint_0;
elsif Left = Uint_1 then
return Uint_1;
elsif Right = Uint_1 then
return Left;
elsif Right <= Uint_64 then
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;
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;
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;
function UI_From_CC (Input : Char_Code) return Uint is
begin
return UI_From_Dint (Dint (Input));
end UI_From_CC;
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);
else
declare
Max_For_Dint : constant := 5;
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;
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;
U := UI_Ints.Get (Input);
if U /= No_Uint then
return U;
end if;
declare
Max_For_Int : constant := 3;
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;
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;
function UI_GCD (Uin, Vin : Uint) return Uint is
U, V : Uint;
U_Hat, V_Hat : Int;
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
Den1 := V_Hat + C;
Den2 := V_Hat + D;
exit when (Den1 * Den2) = Int_0;
Q := (U_Hat + A) / Den1;
exit when Q /= ((U_Hat + B) / Den2);
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;
if B = Int_0 then
Tmp_UI := U rem V;
U := V;
V := Tmp_UI;
else
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 Iterations > 100 then
Release_And_Save (Marks, U, V);
Iterations := 0;
end if;
end loop;
end UI_GCD;
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;
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;
procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
begin
Image_Out (Input, True, Format);
end UI_Image;
function UI_Is_In_Int_Range (Input : Uint) return Boolean is
begin
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;
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;
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
if Int (Left) = Int (Right) then
return False;
elsif Direct (Left) and then Direct (Right) then
return Int (Left) < Int (Right);
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
if R_Vec (1) >= Int_0 then
return True;
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
if R_Vec (1) < Int_0 then
return False;
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;
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;
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;
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;
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
if Direct (Left) and then Direct (Right) then
return
UI_From_Dint
(Dint (Direct_Val (Left)) * Dint (Direct_Val (Right)));
end if;
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;
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
if Int (Left) = Int (Right) then
return False;
end if;
if Direct (Left) then
if Direct (Right) then
return Int (Left) /= Int (Right);
else
return True;
end if;
elsif Direct (Right) then
return True;
end if;
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;
function UI_Negate (Right : Uint) return Uint is
begin
if Direct (Right) then
return UI_From_Int (-Direct_Val (Right));
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;
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
if (Right <= Uint_12) and then (Right >= Uint_Minus_12) then
if Left < Uint_0 then
Sign := -1;
else
Sign := 1;
end if;
case Int1_12 (abs (Direct_Val (Right))) is
when 1 =>
return Uint_0;
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));
when 3 =>
return UI_From_Int (
Sign * (Sum_Double_Digits (Left, 1) rem Int (3)));
when 7 =>
return UI_From_Int (
Sign * (Sum_Digits (Left, 1) rem Int (7)));
when 5 =>
Tmp := Sum_Double_Digits (Left, -1) mod Int (5);
return UI_From_Int (Sign * Tmp);
when 9 =>
Tmp := Sum_Digits (Left, -1) mod Int (9);
return UI_From_Int (Sign * Tmp);
when 11 =>
Tmp := Sum_Digits (Left, -1) mod Int (11);
return UI_From_Int (Sign * Tmp);
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));
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));
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;
end if;
end if;
return Left - (Left / Right) * Right;
end UI_Rem;
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;
function UI_To_CC (Input : Uint) return Char_Code is
begin
if Direct (Input) then
return Char_Code (Direct_Val (Input));
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);
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;
function UI_To_Int (Input : Uint) return Int is
begin
if Direct (Input) then
return Direct_Val (Input);
else
declare
In_Length : constant Int := N_Digits (Input);
In_Vec : UI_Vector (1 .. In_Length);
Ret_Int : Int;
begin
pragma Assert (UI_Is_In_Int_Range (Input));
Init_Operand (Input, In_Vec);
Ret_Int := 0;
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;
procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is
begin
Image_Out (Input, False, Format);
end UI_Write;
function Vector_To_Uint
(In_Vec : UI_Vector;
Negative : Boolean)
return Uint
is
Size : Int;
Val : Int;
begin
for J in In_Vec'Range loop
if In_Vec (J) /= Int_0 then
Size := In_Vec'Last - J + 1;
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;
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;
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;
return Uint_0;
end Vector_To_Uint;
end Uintp;