gcc/ada/uintp.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                U I N T P                                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with Output;  use Output;
  35 with Tree_IO; use Tree_IO;
  36
  37 with GNAT.HTable; use GNAT.HTable;
  38
  39 package body Uintp is
  40
  41    ------------------------
  42    -- Local Declarations --
  43    ------------------------
  44
  45    Uint_Int_First : Uint := Uint_0;
  46    --  Uint value containing Int'First value, set by Initialize. The initial
  47    --  value of Uint_0 is used for an assertion check that ensures that this
  48    --  value is not used before it is initialized. This value is used in the
  49    --  UI_Is_In_Int_Range predicate, and it is right that this is a host value,
  50    --  since the issue is host representation of integer values.
  51
  52    Uint_Int_Last : Uint;
  53    --  Uint value containing Int'Last value set by Initialize
  54
  55    UI_Power_2 : array (Int range 0 .. 64) of Uint;
  56    --  This table is used to memoize exponentiations by powers of 2. The Nth
  57    --  entry, if set, contains the Uint value 2 ** N. Initially UI_Power_2_Set
  58    --  is zero and only the 0'th entry is set, the invariant being that all
  59    --  entries in the range 0 .. UI_Power_2_Set are initialized.
  60
  61    UI_Power_2_Set : Nat;
  62    --  Number of entries set in UI_Power_2;
  63
  64    UI_Power_10 : array (Int range 0 .. 64) of Uint;
  65    --  This table is used to memoize exponentiations by powers of 10 in the
  66    --  same manner as described above for UI_Power_2.
  67
  68    UI_Power_10_Set : Nat;
  69    --  Number of entries set in UI_Power_10;
  70
  71    Uints_Min   : Uint;
  72    Udigits_Min : Int;
  73    --  These values are used to make sure that the mark/release mechanism does
  74    --  not destroy values saved in the U_Power tables or in the hash table used
  75    --  by UI_From_Int. Whenever an entry is made in either of these tabls,
  76    --  Uints_Min and Udigits_Min are updated to protect the entry, and Release
  77    --  never cuts back beyond these minimum values.
  78
  79    Int_0 : constant Int := 0;
  80    Int_1 : constant Int := 1;
  81    Int_2 : constant Int := 2;
  82    --  These values are used in some cases where the use of numeric literals
  83    --  would cause ambiguities (integer vs Uint).
  84
  85    ----------------------------
  86    -- UI_From_Int Hash Table --
  87    ----------------------------
  88
  89    --  UI_From_Int uses a hash table to avoid duplicating entries and wasting
  90    --  storage. This is particularly important for complex cases of back
  91    --  annotation.
  92
  93    subtype Hnum is Nat range 0 .. 1022;
  94
  95    function Hash_Num (F : Int) return Hnum;
  96    --  Hashing function
  97
  98    package UI_Ints is new Simple_HTable (
  99      Header_Num => Hnum,
 100      Element    => Uint,
 101      No_Element => No_Uint,
 102      Key        => Int,
 103      Hash       => Hash_Num,
 104      Equal      => "=");
 105
 106    -----------------------
 107    -- Local Subprograms --
 108    -----------------------
 109
 110    function Direct (U : Uint) return Boolean;
 111    pragma Inline (Direct);
 112    --  Returns True if U is represented directly
 113
 114    function Direct_Val (U : Uint) return Int;
 115    --  U is a Uint for is represented directly. The returned result is the
 116    --  value represented.
 117
 118    function GCD (Jin, Kin : Int) return Int;
 119    --  Compute GCD of two integers. Assumes that Jin >= Kin >= 0
 120
 121    procedure Image_Out
 122      (Input     : Uint;
 123       To_Buffer : Boolean;
 124       Format    : UI_Format);
 125    --  Common processing for UI_Image and UI_Write, To_Buffer is set True for
 126    --  UI_Image, and false for UI_Write, and Format is copied from the Format
 127    --  parameter to UI_Image or UI_Write.
 128
 129    procedure Init_Operand (UI : Uint; Vec : out UI_Vector);
 130    pragma Inline (Init_Operand);
 131    --  This procedure puts the value of UI into the vector in canonical
 132    --  multiple precision format. The parameter should be of the correct size
 133    --  as determined by a previous call to N_Digits (UI). The first digit of
 134    --  Vec contains the sign, all other digits are always non- negative. Note
 135    --  that the input may be directly represented, and in this case Vec will
 136    --  contain the corresponding one or two digit value. The low bound of Vec
 137    --  is always 1.
 138
 139    function Least_Sig_Digit (Arg : Uint) return Int;
 140    pragma Inline (Least_Sig_Digit);
 141    --  Returns the Least Significant Digit of Arg quickly. When the given Uint
 142    --  is less than 2**15, the value returned is the input value, in this case
 143    --  the result may be negative. It is expected that any use will mask off
 144    --  unnecessary bits. This is used for finding Arg mod B where B is a power
 145    --  of two. Hence the actual base is irrelevent as long as it is a power of
 146    --  two.
 147
 148    procedure Most_Sig_2_Digits
 149      (Left      : Uint;
 150       Right     : Uint;
 151       Left_Hat  : out Int;
 152       Right_Hat : out Int);
 153    --  Returns leading two significant digits from the given pair of Uint's.
 154    --  Mathematically: returns Left / (Base ** K) and Right / (Base ** K) where
 155    --  K is as small as possible S.T. Right_Hat < Base * Base. It is required
 156    --  that Left > Right for the algorithm to work.
 157
 158    function N_Digits (Input : Uint) return Int;
 159    pragma Inline (N_Digits);
 160    --  Returns number of "digits" in a Uint
 161
 162    function Sum_Digits (Left : Uint; Sign : Int) return Int;
 163    --  If Sign = 1 return the sum of the "digits" of Abs (Left). If the total
 164    --  has more then one digit then return Sum_Digits of total.
 165
 166    function Sum_Double_Digits (Left : Uint; Sign : Int) return Int;
 167    --  Same as above but work in New_Base = Base * Base
 168
 169    procedure UI_Div_Rem
 170      (Left, Right       : Uint;
 171       Quotient          : out Uint;
 172       Remainder         : out Uint;
 173       Discard_Quotient  : Boolean;
 174       Discard_Remainder : Boolean);
 175    --  Compute euclidian division of Left by Right, and return Quotient and
 176    --  signed Remainder (Left rem Right).
 177    --
 178    --    If Discard_Quotient is True, Quotient is left unchanged.
 179    --    If Discard_Remainder is True, Remainder is left unchanged.
 180
 181    function Vector_To_Uint
 182      (In_Vec   : UI_Vector;
 183       Negative : Boolean) return Uint;
 184    --  Functions that calculate values in UI_Vectors, call this function to
 185    --  create and return the Uint value. In_Vec contains the multiple precision
 186    --  (Base) representation of a non-negative value. Leading zeroes are
 187    --  permitted. Negative is set if the desired result is the negative of the
 188    --  given value. The result will be either the appropriate directly
 189    --  represented value, or a table entry in the proper canonical format is
 190    --  created and returned.
 191    --
 192    --  Note that Init_Operand puts a signed value in the result vector, but
 193    --  Vector_To_Uint is always presented with a non-negative value. The
 194    --  processing of signs is something that is done by the caller before
 195    --  calling Vector_To_Uint.
 196
 197    ------------
 198    -- Direct --
 199    ------------
 200
 201    function Direct (U : Uint) return Boolean is
 202    begin
 203       return Int (U) <= Int (Uint_Direct_Last);
 204    end Direct;
 205
 206    ----------------
 207    -- Direct_Val --
 208    ----------------
 209
 210    function Direct_Val (U : Uint) return Int is
 211    begin
 212       pragma Assert (Direct (U));
 213       return Int (U) - Int (Uint_Direct_Bias);
 214    end Direct_Val;
 215
 216    ---------
 217    -- GCD --
 218    ---------
 219
 220    function GCD (Jin, Kin : Int) return Int is
 221       J, K, Tmp : Int;
 222
 223    begin
 224       pragma Assert (Jin >= Kin);
 225       pragma Assert (Kin >= Int_0);
 226
 227       J := Jin;
 228       K := Kin;
 229       while K /= Uint_0 loop
 230          Tmp := J mod K;
 231          J := K;
 232          K := Tmp;
 233       end loop;
 234
 235       return J;
 236    end GCD;
 237
 238    --------------
 239    -- Hash_Num --
 240    --------------
 241
 242    function Hash_Num (F : Int) return Hnum is
 243    begin
 244       return Standard."mod" (F, Hnum'Range_Length);
 245    end Hash_Num;
 246
 247    ---------------
 248    -- Image_Out --
 249    ---------------
 250
 251    procedure Image_Out
 252      (Input     : Uint;
 253       To_Buffer : Boolean;
 254       Format    : UI_Format)
 255    is
 256       Marks  : constant Uintp.Save_Mark := Uintp.Mark;
 257       Base   : Uint;
 258       Ainput : Uint;
 259
 260       Digs_Output : Natural := 0;
 261       --  Counts digits output. In hex mode, but not in decimal mode, we
 262       --  put an underline after every four hex digits that are output.
 263
 264       Exponent : Natural := 0;
 265       --  If the number is too long to fit in the buffer, we switch to an
 266       --  approximate output format with an exponent. This variable records
 267       --  the exponent value.
 268
 269       function Better_In_Hex return Boolean;
 270       --  Determines if it is better to generate digits in base 16 (result
 271       --  is true) or base 10 (result is false). The choice is purely a
 272       --  matter of convenience and aesthetics, so it does not matter which
 273       --  value is returned from a correctness point of view.
 274
 275       procedure Image_Char (C : Character);
 276       --  Internal procedure to output one character
 277
 278       procedure Image_Exponent (N : Natural);
 279       --  Output non-zero exponent. Note that we only use the exponent form in
 280       --  the buffer case, so we know that To_Buffer is true.
 281
 282       procedure Image_Uint (U : Uint);
 283       --  Internal procedure to output characters of non-negative Uint
 284
 285       -------------------
 286       -- Better_In_Hex --
 287       -------------------
 288
 289       function Better_In_Hex return Boolean is
 290          T16 : constant Uint := Uint_2 ** Int'(16);
 291          A   : Uint;
 292
 293       begin
 294          A := UI_Abs (Input);
 295
 296          --  Small values up to 2**16 can always be in decimal
 297
 298          if A < T16 then
 299             return False;
 300          end if;
 301
 302          --  Otherwise, see if we are a power of 2 or one less than a power
 303          --  of 2. For the moment these are the only cases printed in hex.
 304
 305          if A mod Uint_2 = Uint_1 then
 306             A := A + Uint_1;
 307          end if;
 308
 309          loop
 310             if A mod T16 /= Uint_0 then
 311                return False;
 312
 313             else
 314                A := A / T16;
 315             end if;
 316
 317             exit when A < T16;
 318          end loop;
 319
 320          while A > Uint_2 loop
 321             if A mod Uint_2 /= Uint_0 then
 322                return False;
 323
 324             else
 325                A := A / Uint_2;
 326             end if;
 327          end loop;
 328
 329          return True;
 330       end Better_In_Hex;
 331
 332       ----------------
 333       -- Image_Char --
 334       ----------------
 335
 336       procedure Image_Char (C : Character) is
 337       begin
 338          if To_Buffer then
 339             if UI_Image_Length + 6 > UI_Image_Max then
 340                Exponent := Exponent + 1;
 341             else
 342                UI_Image_Length := UI_Image_Length + 1;
 343                UI_Image_Buffer (UI_Image_Length) := C;
 344             end if;
 345          else
 346             Write_Char (C);
 347          end if;
 348       end Image_Char;
 349
 350       --------------------
 351       -- Image_Exponent --
 352       --------------------
 353
 354       procedure Image_Exponent (N : Natural) is
 355       begin
 356          if N >= 10 then
 357             Image_Exponent (N / 10);
 358          end if;
 359
 360          UI_Image_Length := UI_Image_Length + 1;
 361          UI_Image_Buffer (UI_Image_Length) :=
 362            Character'Val (Character'Pos ('0') + N mod 10);
 363       end Image_Exponent;
 364
 365       ----------------
 366       -- Image_Uint --
 367       ----------------
 368
 369       procedure Image_Uint (U : Uint) is
 370          H : constant array (Int range 0 .. 15) of Character :=
 371                "0123456789ABCDEF";
 372
 373       begin
 374          if U >= Base then
 375             Image_Uint (U / Base);
 376          end if;
 377
 378          if Digs_Output = 4 and then Base = Uint_16 then
 379             Image_Char ('_');
 380             Digs_Output := 0;
 381          end if;
 382
 383          Image_Char (H (UI_To_Int (U rem Base)));
 384
 385          Digs_Output := Digs_Output + 1;
 386       end Image_Uint;
 387
 388    --  Start of processing for Image_Out
 389
 390    begin
 391       if Input = No_Uint then
 392          Image_Char ('?');
 393          return;
 394       end if;
 395
 396       UI_Image_Length := 0;
 397
 398       if Input < Uint_0 then
 399          Image_Char ('-');
 400          Ainput := -Input;
 401       else
 402          Ainput := Input;
 403       end if;
 404
 405       if Format = Hex
 406         or else (Format = Auto and then Better_In_Hex)
 407       then
 408          Base := Uint_16;
 409          Image_Char ('1');
 410          Image_Char ('6');
 411          Image_Char ('#');
 412          Image_Uint (Ainput);
 413          Image_Char ('#');
 414
 415       else
 416          Base := Uint_10;
 417          Image_Uint (Ainput);
 418       end if;
 419
 420       if Exponent /= 0 then
 421          UI_Image_Length := UI_Image_Length + 1;
 422          UI_Image_Buffer (UI_Image_Length) := 'E';
 423          Image_Exponent (Exponent);
 424       end if;
 425
 426       Uintp.Release (Marks);
 427    end Image_Out;
 428
 429    -------------------
 430    -- Init_Operand --
 431    -------------------
 432
 433    procedure Init_Operand (UI : Uint; Vec : out UI_Vector) is
 434       Loc : Int;
 435
 436       pragma Assert (Vec'First = Int'(1));
 437
 438    begin
 439       if Direct (UI) then
 440          Vec (1) := Direct_Val (UI);
 441
 442          if Vec (1) >= Base then
 443             Vec (2) := Vec (1) rem Base;
 444             Vec (1) := Vec (1) / Base;
 445          end if;
 446
 447       else
 448          Loc := Uints.Table (UI).Loc;
 449
 450          for J in 1 .. Uints.Table (UI).Length loop
 451             Vec (J) := Udigits.Table (Loc + J - 1);
 452          end loop;
 453       end if;
 454    end Init_Operand;
 455
 456    ----------------
 457    -- Initialize --
 458    ----------------
 459
 460    procedure Initialize is
 461    begin
 462       Uints.Init;
 463       Udigits.Init;
 464
 465       Uint_Int_First := UI_From_Int (Int'First);
 466       Uint_Int_Last  := UI_From_Int (Int'Last);
 467
 468       UI_Power_2 (0) := Uint_1;
 469       UI_Power_2_Set := 0;
 470
 471       UI_Power_10 (0) := Uint_1;
 472       UI_Power_10_Set := 0;
 473
 474       Uints_Min := Uints.Last;
 475       Udigits_Min := Udigits.Last;
 476
 477       UI_Ints.Reset;
 478    end Initialize;
 479
 480    ---------------------
 481    -- Least_Sig_Digit --
 482    ---------------------
 483
 484    function Least_Sig_Digit (Arg : Uint) return Int is
 485       V : Int;
 486
 487    begin
 488       if Direct (Arg) then
 489          V := Direct_Val (Arg);
 490
 491          if V >= Base then
 492             V := V mod Base;
 493          end if;
 494
 495          --  Note that this result may be negative
 496
 497          return V;
 498
 499       else
 500          return
 501            Udigits.Table
 502             (Uints.Table (Arg).Loc + Uints.Table (Arg).Length - 1);
 503       end if;
 504    end Least_Sig_Digit;
 505
 506    ----------
 507    -- Mark --
 508    ----------
 509
 510    function Mark return Save_Mark is
 511    begin
 512       return (Save_Uint => Uints.Last, Save_Udigit => Udigits.Last);
 513    end Mark;
 514
 515    -----------------------
 516    -- Most_Sig_2_Digits --
 517    -----------------------
 518
 519    procedure Most_Sig_2_Digits
 520      (Left      : Uint;
 521       Right     : Uint;
 522       Left_Hat  : out Int;
 523       Right_Hat : out Int)
 524    is
 525    begin
 526       pragma Assert (Left >= Right);
 527
 528       if Direct (Left) then
 529          Left_Hat  := Direct_Val (Left);
 530          Right_Hat := Direct_Val (Right);
 531          return;
 532
 533       else
 534          declare
 535             L1 : constant Int :=
 536                    Udigits.Table (Uints.Table (Left).Loc);
 537             L2 : constant Int :=
 538                    Udigits.Table (Uints.Table (Left).Loc + 1);
 539
 540          begin
 541             --  It is not so clear what to return when Arg is negative???
 542
 543             Left_Hat := abs (L1) * Base + L2;
 544          end;
 545       end if;
 546
 547       declare
 548          Length_L : constant Int := Uints.Table (Left).Length;
 549          Length_R : Int;
 550          R1 : Int;
 551          R2 : Int;
 552          T  : Int;
 553
 554       begin
 555          if Direct (Right) then
 556             T := Direct_Val (Left);
 557             R1 := abs (T / Base);
 558             R2 := T rem Base;
 559             Length_R := 2;
 560
 561          else
 562             R1 := abs (Udigits.Table (Uints.Table (Right).Loc));
 563             R2 := Udigits.Table (Uints.Table (Right).Loc + 1);
 564             Length_R := Uints.Table (Right).Length;
 565          end if;
 566
 567          if Length_L = Length_R then
 568             Right_Hat := R1 * Base + R2;
 569          elsif Length_L = Length_R + Int_1 then
 570             Right_Hat := R1;
 571          else
 572             Right_Hat := 0;
 573          end if;
 574       end;
 575    end Most_Sig_2_Digits;
 576
 577    ---------------
 578    -- N_Digits --
 579    ---------------
 580
 581    --  Note: N_Digits returns 1 for No_Uint
 582
 583    function N_Digits (Input : Uint) return Int is
 584    begin
 585       if Direct (Input) then
 586          if Direct_Val (Input) >= Base then
 587             return 2;
 588          else
 589             return 1;
 590          end if;
 591
 592       else
 593          return Uints.Table (Input).Length;
 594       end if;
 595    end N_Digits;
 596
 597    --------------
 598    -- Num_Bits --
 599    --------------
 600
 601    function Num_Bits (Input : Uint) return Nat is
 602       Bits : Nat;
 603       Num  : Nat;
 604
 605    begin
 606       --  Largest negative number has to be handled specially, since it is in
 607       --  Int_Range, but we cannot take the absolute value.
 608
 609       if Input = Uint_Int_First then
 610          return Int'Size;
 611
 612       --  For any other number in Int_Range, get absolute value of number
 613
 614       elsif UI_Is_In_Int_Range (Input) then
 615          Num := abs (UI_To_Int (Input));
 616          Bits := 0;
 617
 618       --  If not in Int_Range then initialize bit count for all low order
 619       --  words, and set number to high order digit.
 620
 621       else
 622          Bits := Base_Bits * (Uints.Table (Input).Length - 1);
 623          Num  := abs (Udigits.Table (Uints.Table (Input).Loc));
 624       end if;
 625
 626       --  Increase bit count for remaining value in Num
 627
 628       while Types.">" (Num, 0) loop
 629          Num := Num / 2;
 630          Bits := Bits + 1;
 631       end loop;
 632
 633       return Bits;
 634    end Num_Bits;
 635
 636    ---------
 637    -- pid --
 638    ---------
 639
 640    procedure pid (Input : Uint) is
 641    begin
 642       UI_Write (Input, Decimal);
 643       Write_Eol;
 644    end pid;
 645
 646    ---------
 647    -- pih --
 648    ---------
 649
 650    procedure pih (Input : Uint) is
 651    begin
 652       UI_Write (Input, Hex);
 653       Write_Eol;
 654    end pih;
 655
 656    -------------
 657    -- Release --
 658    -------------
 659
 660    procedure Release (M : Save_Mark) is
 661    begin
 662       Uints.Set_Last   (Uint'Max (M.Save_Uint,   Uints_Min));
 663       Udigits.Set_Last (Int'Max  (M.Save_Udigit, Udigits_Min));
 664    end Release;
 665
 666    ----------------------
 667    -- Release_And_Save --
 668    ----------------------
 669
 670    procedure Release_And_Save (M : Save_Mark; UI : in out Uint) is
 671    begin
 672       if Direct (UI) then
 673          Release (M);
 674
 675       else
 676          declare
 677             UE_Len : constant Pos := Uints.Table (UI).Length;
 678             UE_Loc : constant Int := Uints.Table (UI).Loc;
 679
 680             UD : constant Udigits.Table_Type (1 .. UE_Len) :=
 681                    Udigits.Table (UE_Loc .. UE_Loc + UE_Len - 1);
 682
 683          begin
 684             Release (M);
 685
 686             Uints.Increment_Last;
 687             UI := Uints.Last;
 688
 689             Uints.Table (UI) := (UE_Len, Udigits.Last + 1);
 690
 691             for J in 1 .. UE_Len loop
 692                Udigits.Increment_Last;
 693                Udigits.Table (Udigits.Last) := UD (J);
 694             end loop;
 695          end;
 696       end if;
 697    end Release_And_Save;
 698
 699    procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint) is
 700    begin
 701       if Direct (UI1) then
 702          Release_And_Save (M, UI2);
 703
 704       elsif Direct (UI2) then
 705          Release_And_Save (M, UI1);
 706
 707       else
 708          declare
 709             UE1_Len : constant Pos := Uints.Table (UI1).Length;
 710             UE1_Loc : constant Int := Uints.Table (UI1).Loc;
 711
 712             UD1 : constant Udigits.Table_Type (1 .. UE1_Len) :=
 713                     Udigits.Table (UE1_Loc .. UE1_Loc + UE1_Len - 1);
 714
 715             UE2_Len : constant Pos := Uints.Table (UI2).Length;
 716             UE2_Loc : constant Int := Uints.Table (UI2).Loc;
 717
 718             UD2 : constant Udigits.Table_Type (1 .. UE2_Len) :=
 719                     Udigits.Table (UE2_Loc .. UE2_Loc + UE2_Len - 1);
 720
 721          begin
 722             Release (M);
 723
 724             Uints.Increment_Last;
 725             UI1 := Uints.Last;
 726
 727             Uints.Table (UI1) := (UE1_Len, Udigits.Last + 1);
 728
 729             for J in 1 .. UE1_Len loop
 730                Udigits.Increment_Last;
 731                Udigits.Table (Udigits.Last) := UD1 (J);
 732             end loop;
 733
 734             Uints.Increment_Last;
 735             UI2 := Uints.Last;
 736
 737             Uints.Table (UI2) := (UE2_Len, Udigits.Last + 1);
 738
 739             for J in 1 .. UE2_Len loop
 740                Udigits.Increment_Last;
 741                Udigits.Table (Udigits.Last) := UD2 (J);
 742             end loop;
 743          end;
 744       end if;
 745    end Release_And_Save;
 746
 747    ----------------
 748    -- Sum_Digits --
 749    ----------------
 750
 751    --  This is done in one pass
 752
 753    --  Mathematically: assume base congruent to 1 and compute an equivelent
 754    --  integer to Left.
 755
 756    --  If Sign = -1 return the alternating sum of the "digits"
 757
 758    --     D1 - D2 + D3 - D4 + D5 ...
 759
 760    --  (where D1 is Least Significant Digit)
 761
 762    --  Mathematically: assume base congruent to -1 and compute an equivelent
 763    --  integer to Left.
 764
 765    --  This is used in Rem and Base is assumed to be 2 ** 15
 766
 767    --  Note: The next two functions are very similar, any style changes made
 768    --  to one should be reflected in both.  These would be simpler if we
 769    --  worked base 2 ** 32.
 770
 771    function Sum_Digits (Left : Uint; Sign : Int) return Int is
 772    begin
 773       pragma Assert (Sign = Int_1 or Sign = Int (-1));
 774
 775       --  First try simple case;
 776
 777       if Direct (Left) then
 778          declare
 779             Tmp_Int : Int := Direct_Val (Left);
 780
 781          begin
 782             if Tmp_Int >= Base then
 783                Tmp_Int := (Tmp_Int / Base) +
 784                   Sign * (Tmp_Int rem Base);
 785
 786                   --  Now Tmp_Int is in [-(Base - 1) .. 2 * (Base - 1)]
 787
 788                if Tmp_Int >= Base then
 789
 790                   --  Sign must be 1
 791
 792                   Tmp_Int := (Tmp_Int / Base) + 1;
 793
 794                end if;
 795
 796                --  Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
 797
 798             end if;
 799
 800             return Tmp_Int;
 801          end;
 802
 803       --  Otherwise full circuit is needed
 804
 805       else
 806          declare
 807             L_Length : constant Int := N_Digits (Left);
 808             L_Vec    : UI_Vector (1 .. L_Length);
 809             Tmp_Int  : Int;
 810             Carry    : Int;
 811             Alt      : Int;
 812
 813          begin
 814             Init_Operand (Left, L_Vec);
 815             L_Vec (1) := abs L_Vec (1);
 816             Tmp_Int := 0;
 817             Carry := 0;
 818             Alt := 1;
 819
 820             for J in reverse 1 .. L_Length loop
 821                Tmp_Int := Tmp_Int + Alt * (L_Vec (J) + Carry);
 822
 823                --  Tmp_Int is now between [-2 * Base + 1 .. 2 * Base - 1],
 824                --  since old Tmp_Int is between [-(Base - 1) .. Base - 1]
 825                --  and L_Vec is in [0 .. Base - 1] and Carry in [-1 .. 1]
 826
 827                if Tmp_Int >= Base then
 828                   Tmp_Int := Tmp_Int - Base;
 829                   Carry := 1;
 830
 831                elsif Tmp_Int <= -Base then
 832                   Tmp_Int := Tmp_Int + Base;
 833                   Carry := -1;
 834
 835                else
 836                   Carry := 0;
 837                end if;
 838
 839                --  Tmp_Int is now between [-Base + 1 .. Base - 1]
 840
 841                Alt := Alt * Sign;
 842             end loop;
 843
 844             Tmp_Int := Tmp_Int + Alt * Carry;
 845
 846             --  Tmp_Int is now between [-Base .. Base]
 847
 848             if Tmp_Int >= Base then
 849                Tmp_Int := Tmp_Int - Base + Alt * Sign * 1;
 850
 851             elsif Tmp_Int <= -Base then
 852                Tmp_Int := Tmp_Int + Base + Alt * Sign * (-1);
 853             end if;
 854
 855             --  Now Tmp_Int is in [-(Base - 1) .. (Base - 1)]
 856
 857             return Tmp_Int;
 858          end;
 859       end if;
 860    end Sum_Digits;
 861
 862    -----------------------
 863    -- Sum_Double_Digits --
 864    -----------------------
 865
 866    --  Note: This is used in Rem, Base is assumed to be 2 ** 15
 867
 868    function Sum_Double_Digits (Left : Uint; Sign : Int) return Int is
 869    begin
 870       --  First try simple case;
 871
 872       pragma Assert (Sign = Int_1 or Sign = Int (-1));
 873
 874       if Direct (Left) then
 875          return Direct_Val (Left);
 876
 877       --  Otherwise full circuit is needed
 878
 879       else
 880          declare
 881             L_Length      : constant Int := N_Digits (Left);
 882             L_Vec         : UI_Vector (1 .. L_Length);
 883             Most_Sig_Int  : Int;
 884             Least_Sig_Int : Int;
 885             Carry         : Int;
 886             J             : Int;
 887             Alt           : Int;
 888
 889          begin
 890             Init_Operand (Left, L_Vec);
 891             L_Vec (1) := abs L_Vec (1);
 892             Most_Sig_Int := 0;
 893             Least_Sig_Int := 0;
 894             Carry := 0;
 895             Alt := 1;
 896             J := L_Length;
 897
 898             while J > Int_1 loop
 899                Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry);
 900
 901                --  Least is in [-2 Base + 1 .. 2 * Base - 1]
 902                --  Since L_Vec in [0 .. Base - 1] and Carry in [-1 .. 1]
 903                --  and old Least in [-Base + 1 .. Base - 1]
 904
 905                if Least_Sig_Int >= Base then
 906                   Least_Sig_Int := Least_Sig_Int - Base;
 907                   Carry := 1;
 908
 909                elsif Least_Sig_Int <= -Base then
 910                   Least_Sig_Int := Least_Sig_Int + Base;
 911                   Carry := -1;
 912
 913                else
 914                   Carry := 0;
 915                end if;
 916
 917                --  Least is now in [-Base + 1 .. Base - 1]
 918
 919                Most_Sig_Int := Most_Sig_Int + Alt * (L_Vec (J - 1) + Carry);
 920
 921                --  Most is in [-2 Base + 1 .. 2 * Base - 1]
 922                --  Since L_Vec in [0 ..  Base - 1] and Carry in  [-1 .. 1]
 923                --  and old Most in [-Base + 1 .. Base - 1]
 924
 925                if Most_Sig_Int >= Base then
 926                   Most_Sig_Int := Most_Sig_Int - Base;
 927                   Carry := 1;
 928
 929                elsif Most_Sig_Int <= -Base then
 930                   Most_Sig_Int := Most_Sig_Int + Base;
 931                   Carry := -1;
 932                else
 933                   Carry := 0;
 934                end if;
 935
 936                --  Most is now in [-Base + 1 .. Base - 1]
 937
 938                J := J - 2;
 939                Alt := Alt * Sign;
 940             end loop;
 941
 942             if J = Int_1 then
 943                Least_Sig_Int := Least_Sig_Int + Alt * (L_Vec (J) + Carry);
 944             else
 945                Least_Sig_Int := Least_Sig_Int + Alt * Carry;
 946             end if;
 947
 948             if Least_Sig_Int >= Base then
 949                Least_Sig_Int := Least_Sig_Int - Base;
 950                Most_Sig_Int := Most_Sig_Int + Alt * 1;
 951
 952             elsif Least_Sig_Int <= -Base then
 953                Least_Sig_Int := Least_Sig_Int + Base;
 954                Most_Sig_Int := Most_Sig_Int + Alt * (-1);
 955             end if;
 956
 957             if Most_Sig_Int >= Base then
 958                Most_Sig_Int := Most_Sig_Int - Base;
 959                Alt := Alt * Sign;
 960                Least_Sig_Int :=
 961                  Least_Sig_Int + Alt * 1; -- cannot overflow again
 962
 963             elsif Most_Sig_Int <= -Base then
 964                Most_Sig_Int := Most_Sig_Int + Base;
 965                Alt := Alt * Sign;
 966                Least_Sig_Int :=
 967                  Least_Sig_Int + Alt * (-1); --  cannot overflow again.
 968             end if;
 969
 970             return Most_Sig_Int * Base + Least_Sig_Int;
 971          end;
 972       end if;
 973    end Sum_Double_Digits;
 974
 975    ---------------
 976    -- Tree_Read --
 977    ---------------
 978
 979    procedure Tree_Read is
 980    begin
 981       Uints.Tree_Read;
 982       Udigits.Tree_Read;
 983
 984       Tree_Read_Int (Int (Uint_Int_First));
 985       Tree_Read_Int (Int (Uint_Int_Last));
 986       Tree_Read_Int (UI_Power_2_Set);
 987       Tree_Read_Int (UI_Power_10_Set);
 988       Tree_Read_Int (Int (Uints_Min));
 989       Tree_Read_Int (Udigits_Min);
 990
 991       for J in 0 .. UI_Power_2_Set loop
 992          Tree_Read_Int (Int (UI_Power_2 (J)));
 993       end loop;
 994
 995       for J in 0 .. UI_Power_10_Set loop
 996          Tree_Read_Int (Int (UI_Power_10 (J)));
 997       end loop;
 998
 999    end Tree_Read;
1000
1001    ----------------
1002    -- Tree_Write --
1003    ----------------
1004
1005    procedure Tree_Write is
1006    begin
1007       Uints.Tree_Write;
1008       Udigits.Tree_Write;
1009
1010       Tree_Write_Int (Int (Uint_Int_First));
1011       Tree_Write_Int (Int (Uint_Int_Last));
1012       Tree_Write_Int (UI_Power_2_Set);
1013       Tree_Write_Int (UI_Power_10_Set);
1014       Tree_Write_Int (Int (Uints_Min));
1015       Tree_Write_Int (Udigits_Min);
1016
1017       for J in 0 .. UI_Power_2_Set loop
1018          Tree_Write_Int (Int (UI_Power_2 (J)));
1019       end loop;
1020
1021       for J in 0 .. UI_Power_10_Set loop
1022          Tree_Write_Int (Int (UI_Power_10 (J)));
1023       end loop;
1024
1025    end Tree_Write;
1026
1027    -------------
1028    -- UI_Abs --
1029    -------------
1030
1031    function UI_Abs (Right : Uint) return Uint is
1032    begin
1033       if Right < Uint_0 then
1034          return -Right;
1035       else
1036          return Right;
1037       end if;
1038    end UI_Abs;
1039
1040    -------------
1041    -- UI_Add --
1042    -------------
1043
1044    function UI_Add (Left : Int; Right : Uint) return Uint is
1045    begin
1046       return UI_Add (UI_From_Int (Left), Right);
1047    end UI_Add;
1048
1049    function UI_Add (Left : Uint; Right : Int) return Uint is
1050    begin
1051       return UI_Add (Left, UI_From_Int (Right));
1052    end UI_Add;
1053
1054    function UI_Add (Left : Uint; Right : Uint) return Uint is
1055    begin
1056       --  Simple cases of direct operands and addition of zero
1057
1058       if Direct (Left) then
1059          if Direct (Right) then
1060             return UI_From_Int (Direct_Val (Left) + Direct_Val (Right));
1061
1062          elsif Int (Left) = Int (Uint_0) then
1063             return Right;
1064          end if;
1065
1066       elsif Direct (Right) and then Int (Right) = Int (Uint_0) then
1067          return Left;
1068       end if;
1069
1070       --  Otherwise full circuit is needed
1071
1072       declare
1073          L_Length   : constant Int := N_Digits (Left);
1074          R_Length   : constant Int := N_Digits (Right);
1075          L_Vec      : UI_Vector (1 .. L_Length);
1076          R_Vec      : UI_Vector (1 .. R_Length);
1077          Sum_Length : Int;
1078          Tmp_Int    : Int;
1079          Carry      : Int;
1080          Borrow     : Int;
1081          X_Bigger   : Boolean := False;
1082          Y_Bigger   : Boolean := False;
1083          Result_Neg : Boolean := False;
1084
1085       begin
1086          Init_Operand (Left, L_Vec);
1087          Init_Operand (Right, R_Vec);
1088
1089          --  At least one of the two operands is in multi-digit form.
1090          --  Calculate the number of digits sufficient to hold result.
1091
1092          if L_Length > R_Length then
1093             Sum_Length := L_Length + 1;
1094             X_Bigger := True;
1095          else
1096             Sum_Length := R_Length + 1;
1097
1098             if R_Length > L_Length then
1099                Y_Bigger := True;
1100             end if;
1101          end if;
1102
1103          --  Make copies of the absolute values of L_Vec and R_Vec into X and Y
1104          --  both with lengths equal to the maximum possibly needed. This makes
1105          --  looping over the digits much simpler.
1106
1107          declare
1108             X      : UI_Vector (1 .. Sum_Length);
1109             Y      : UI_Vector (1 .. Sum_Length);
1110             Tmp_UI : UI_Vector (1 .. Sum_Length);
1111
1112          begin
1113             for J in 1 .. Sum_Length - L_Length loop
1114                X (J) := 0;
1115             end loop;
1116
1117             X (Sum_Length - L_Length + 1) := abs L_Vec (1);
1118
1119             for J in 2 .. L_Length loop
1120                X (J + (Sum_Length - L_Length)) := L_Vec (J);
1121             end loop;
1122
1123             for J in 1 .. Sum_Length - R_Length loop
1124                Y (J) := 0;
1125             end loop;
1126
1127             Y (Sum_Length - R_Length + 1) := abs R_Vec (1);
1128
1129             for J in 2 .. R_Length loop
1130                Y (J + (Sum_Length - R_Length)) := R_Vec (J);
1131             end loop;
1132
1133             if (L_Vec (1) < Int_0) = (R_Vec (1) < Int_0) then
1134
1135                --  Same sign so just add
1136
1137                Carry := 0;
1138                for J in reverse 1 .. Sum_Length loop
1139                   Tmp_Int := X (J) + Y (J) + Carry;
1140
1141                   if Tmp_Int >= Base then
1142                      Tmp_Int := Tmp_Int - Base;
1143                      Carry := 1;
1144                   else
1145                      Carry := 0;
1146                   end if;
1147
1148                   X (J) := Tmp_Int;
1149                end loop;
1150
1151                return Vector_To_Uint (X, L_Vec (1) < Int_0);
1152
1153             else
1154                --  Find which one has bigger magnitude
1155
1156                if not (X_Bigger or Y_Bigger) then
1157                   for J in L_Vec'Range loop
1158                      if abs L_Vec (J) > abs R_Vec (J) then
1159                         X_Bigger := True;
1160                         exit;
1161                      elsif abs R_Vec (J) > abs L_Vec (J) then
1162                         Y_Bigger := True;
1163                         exit;
1164                      end if;
1165                   end loop;
1166                end if;
1167
1168                --  If they have identical magnitude, just return 0, else swap
1169                --  if necessary so that X had the bigger magnitude. Determine
1170                --  if result is negative at this time.
1171
1172                Result_Neg := False;
1173
1174                if not (X_Bigger or Y_Bigger) then
1175                   return Uint_0;
1176
1177                elsif Y_Bigger then
1178                   if R_Vec (1) < Int_0 then
1179                      Result_Neg := True;
1180                   end if;
1181
1182                   Tmp_UI := X;
1183                   X := Y;
1184                   Y := Tmp_UI;
1185
1186                else
1187                   if L_Vec (1) < Int_0 then
1188                      Result_Neg := True;
1189                   end if;
1190                end if;
1191
1192                --  Subtract Y from the bigger X
1193
1194                Borrow := 0;
1195
1196                for J in reverse 1 .. Sum_Length loop
1197                   Tmp_Int := X (J) - Y (J) + Borrow;
1198
1199                   if Tmp_Int < Int_0 then
1200                      Tmp_Int := Tmp_Int + Base;
1201                      Borrow := -1;
1202                   else
1203                      Borrow := 0;
1204                   end if;
1205
1206                   X (J) := Tmp_Int;
1207                end loop;
1208
1209                return Vector_To_Uint (X, Result_Neg);
1210
1211             end if;
1212          end;
1213       end;
1214    end UI_Add;
1215
1216    --------------------------
1217    -- UI_Decimal_Digits_Hi --
1218    --------------------------
1219
1220    function UI_Decimal_Digits_Hi (U : Uint) return Nat is
1221    begin
1222       --  The maximum value of a "digit" is 32767, which is 5 decimal digits,
1223       --  so an N_Digit number could take up to 5 times this number of digits.
1224       --  This is certainly too high for large numbers but it is not worth
1225       --  worrying about.
1226
1227       return 5 * N_Digits (U);
1228    end UI_Decimal_Digits_Hi;
1229
1230    --------------------------
1231    -- UI_Decimal_Digits_Lo --
1232    --------------------------
1233
1234    function UI_Decimal_Digits_Lo (U : Uint) return Nat is
1235    begin
1236       --  The maximum value of a "digit" is 32767, which is more than four
1237       --  decimal digits, but not a full five digits. The easily computed
1238       --  minimum number of decimal digits is thus 1 + 4 * the number of
1239       --  digits. This is certainly too low for large numbers but it is not
1240       --  worth worrying about.
1241
1242       return 1 + 4 * (N_Digits (U) - 1);
1243    end UI_Decimal_Digits_Lo;
1244
1245    ------------
1246    -- UI_Div --
1247    ------------
1248
1249    function UI_Div (Left : Int; Right : Uint) return Uint is
1250    begin
1251       return UI_Div (UI_From_Int (Left), Right);
1252    end UI_Div;
1253
1254    function UI_Div (Left : Uint; Right : Int) return Uint is
1255    begin
1256       return UI_Div (Left, UI_From_Int (Right));
1257    end UI_Div;
1258
1259    function UI_Div (Left, Right : Uint) return Uint is
1260       Quotient  : Uint;
1261       Remainder : Uint;
1262       pragma Warnings (Off, Remainder);
1263    begin
1264       UI_Div_Rem
1265         (Left, Right,
1266          Quotient, Remainder,
1267          Discard_Quotient  => False,
1268          Discard_Remainder => True);
1269       return Quotient;
1270    end UI_Div;
1271
1272    ----------------
1273    -- UI_Div_Rem --
1274    ----------------
1275
1276    procedure UI_Div_Rem
1277      (Left, Right       : Uint;
1278       Quotient          : out Uint;
1279       Remainder         : out Uint;
1280       Discard_Quotient  : Boolean;
1281       Discard_Remainder : Boolean)
1282    is
1283       pragma Warnings (Off, Quotient);
1284       pragma Warnings (Off, Remainder);
1285    begin
1286       pragma Assert (Right /= Uint_0);
1287
1288       --  Cases where both operands are represented directly
1289
1290       if Direct (Left) and then Direct (Right) then
1291          declare
1292             DV_Left  : constant Int := Direct_Val (Left);
1293             DV_Right : constant Int := Direct_Val (Right);
1294
1295          begin
1296             if not Discard_Quotient then
1297                Quotient := UI_From_Int (DV_Left / DV_Right);
1298             end if;
1299
1300             if not Discard_Remainder then
1301                Remainder := UI_From_Int (DV_Left rem DV_Right);
1302             end if;
1303
1304             return;
1305          end;
1306       end if;
1307
1308       declare
1309          L_Length    : constant Int := N_Digits (Left);
1310          R_Length    : constant Int := N_Digits (Right);
1311          Q_Length    : constant Int := L_Length - R_Length + 1;
1312          L_Vec       : UI_Vector (1 .. L_Length);
1313          R_Vec       : UI_Vector (1 .. R_Length);
1314          D           : Int;
1315          Remainder_I : Int;
1316          Tmp_Divisor : Int;
1317          Carry       : Int;
1318          Tmp_Int     : Int;
1319          Tmp_Dig     : Int;
1320
1321          procedure UI_Div_Vector
1322            (L_Vec     : UI_Vector;
1323             R_Int     : Int;
1324             Quotient  : out UI_Vector;
1325             Remainder : out Int);
1326          pragma Inline (UI_Div_Vector);
1327          --  Specialised variant for case where the divisor is a single digit
1328
1329          procedure UI_Div_Vector
1330            (L_Vec     : UI_Vector;
1331             R_Int     : Int;
1332             Quotient  : out UI_Vector;
1333             Remainder : out Int)
1334          is
1335             Tmp_Int : Int;
1336
1337          begin
1338             Remainder := 0;
1339             for J in L_Vec'Range loop
1340                Tmp_Int := Remainder * Base + abs L_Vec (J);
1341                Quotient (Quotient'First + J - L_Vec'First) := Tmp_Int / R_Int;
1342                Remainder := Tmp_Int rem R_Int;
1343             end loop;
1344
1345             if L_Vec (L_Vec'First) < Int_0 then
1346                Remainder := -Remainder;
1347             end if;
1348          end UI_Div_Vector;
1349
1350       --  Start of processing for UI_Div_Rem
1351
1352       begin
1353          --  Result is zero if left operand is shorter than right
1354
1355          if L_Length < R_Length then
1356             if not Discard_Quotient then
1357                Quotient := Uint_0;
1358             end if;
1359             if not Discard_Remainder then
1360                Remainder := Left;
1361             end if;
1362             return;
1363          end if;
1364
1365          Init_Operand (Left, L_Vec);
1366          Init_Operand (Right, R_Vec);
1367
1368          --  Case of right operand is single digit. Here we can simply divide
1369          --  each digit of the left operand by the divisor, from most to least
1370          --  significant, carrying the remainder to the next digit (just like
1371          --  ordinary long division by hand).
1372
1373          if R_Length = Int_1 then
1374             Tmp_Divisor := abs R_Vec (1);
1375
1376             declare
1377                Quotient_V : UI_Vector (1 .. L_Length);
1378
1379             begin
1380                UI_Div_Vector (L_Vec, Tmp_Divisor, Quotient_V, Remainder_I);
1381
1382                if not Discard_Quotient then
1383                   Quotient :=
1384                     Vector_To_Uint
1385                       (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1386                end if;
1387
1388                if not Discard_Remainder then
1389                   Remainder := UI_From_Int (Remainder_I);
1390                end if;
1391                return;
1392             end;
1393          end if;
1394
1395          --  The possible simple cases have been exhausted. Now turn to the
1396          --  algorithm D from the section of Knuth mentioned at the top of
1397          --  this package.
1398
1399          Algorithm_D : declare
1400             Dividend     : UI_Vector (1 .. L_Length + 1);
1401             Divisor      : UI_Vector (1 .. R_Length);
1402             Quotient_V   : UI_Vector (1 .. Q_Length);
1403             Divisor_Dig1 : Int;
1404             Divisor_Dig2 : Int;
1405             Q_Guess      : Int;
1406
1407          begin
1408             --  [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1409             --  scale d, and then multiply Left and Right (u and v in the book)
1410             --  by d to get the dividend and divisor to work with.
1411
1412             D := Base / (abs R_Vec (1) + 1);
1413
1414             Dividend (1) := 0;
1415             Dividend (2) := abs L_Vec (1);
1416
1417             for J in 3 .. L_Length + Int_1 loop
1418                Dividend (J) := L_Vec (J - 1);
1419             end loop;
1420
1421             Divisor (1) := abs R_Vec (1);
1422
1423             for J in Int_2 .. R_Length loop
1424                Divisor (J) := R_Vec (J);
1425             end loop;
1426
1427             if D > Int_1 then
1428
1429                --  Multiply Dividend by D
1430
1431                Carry := 0;
1432                for J in reverse Dividend'Range loop
1433                   Tmp_Int      := Dividend (J) * D + Carry;
1434                   Dividend (J) := Tmp_Int rem Base;
1435                   Carry        := Tmp_Int / Base;
1436                end loop;
1437
1438                --  Multiply Divisor by d
1439
1440                Carry := 0;
1441                for J in reverse Divisor'Range loop
1442                   Tmp_Int      := Divisor (J) * D + Carry;
1443                   Divisor (J)  := Tmp_Int rem Base;
1444                   Carry        := Tmp_Int / Base;
1445                end loop;
1446             end if;
1447
1448             --  Main loop of long division algorithm
1449
1450             Divisor_Dig1 := Divisor (1);
1451             Divisor_Dig2 := Divisor (2);
1452
1453             for J in Quotient_V'Range loop
1454
1455                --  [ CALCULATE Q (hat) ] (step D3 in the algorithm)
1456
1457                Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
1458
1459                --  Initial guess
1460
1461                if Dividend (J) = Divisor_Dig1 then
1462                   Q_Guess := Base - 1;
1463                else
1464                   Q_Guess := Tmp_Int / Divisor_Dig1;
1465                end if;
1466
1467                --  Refine the guess
1468
1469                while Divisor_Dig2 * Q_Guess >
1470                      (Tmp_Int - Q_Guess * Divisor_Dig1) * Base +
1471                                                           Dividend (J + 2)
1472                loop
1473                   Q_Guess := Q_Guess - 1;
1474                end loop;
1475
1476                --  [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
1477                --  subtracted from the remaining dividend.
1478
1479                Carry := 0;
1480                for K in reverse Divisor'Range loop
1481                   Tmp_Int := Dividend (J + K) - Q_Guess * Divisor (K) + Carry;
1482                   Tmp_Dig := Tmp_Int rem Base;
1483                   Carry   := Tmp_Int / Base;
1484
1485                   if Tmp_Dig < Int_0 then
1486                      Tmp_Dig := Tmp_Dig + Base;
1487                      Carry   := Carry - 1;
1488                   end if;
1489
1490                   Dividend (J + K) := Tmp_Dig;
1491                end loop;
1492
1493                Dividend (J) := Dividend (J) + Carry;
1494
1495                --  [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
1496
1497                --  Here there is a slight difference from the book: the last
1498                --  carry is always added in above and below (cancelling each
1499                --  other). In fact the dividend going negative is used as
1500                --  the test.
1501
1502                --  If the Dividend went negative, then Q_Guess was off by
1503                --  one, so it is decremented, and the divisor is added back
1504                --  into the relevant portion of the dividend.
1505
1506                if Dividend (J) < Int_0 then
1507                   Q_Guess := Q_Guess - 1;
1508
1509                   Carry := 0;
1510                   for K in reverse Divisor'Range loop
1511                      Tmp_Int := Dividend (J + K) + Divisor (K) + Carry;
1512
1513                      if Tmp_Int >= Base then
1514                         Tmp_Int := Tmp_Int - Base;
1515                         Carry := 1;
1516                      else
1517                         Carry := 0;
1518                      end if;
1519
1520                      Dividend (J + K) := Tmp_Int;
1521                   end loop;
1522
1523                   Dividend (J) := Dividend (J) + Carry;
1524                end if;
1525
1526                --  Finally we can get the next quotient digit
1527
1528                Quotient_V (J) := Q_Guess;
1529             end loop;
1530
1531             --  [ UNNORMALIZE ] (step D8)
1532
1533             if not Discard_Quotient then
1534                Quotient := Vector_To_Uint
1535                  (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1536             end if;
1537
1538             if not Discard_Remainder then
1539                declare
1540                   Remainder_V : UI_Vector (1 .. R_Length);
1541                   Discard_Int : Int;
1542                   pragma Warnings (Off, Discard_Int);
1543                begin
1544                   UI_Div_Vector
1545                     (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last),
1546                      D,
1547                      Remainder_V, Discard_Int);
1548                   Remainder := Vector_To_Uint (Remainder_V, L_Vec (1) < Int_0);
1549                end;
1550             end if;
1551          end Algorithm_D;
1552       end;
1553    end UI_Div_Rem;
1554
1555    ------------
1556    -- UI_Eq --
1557    ------------
1558
1559    function UI_Eq (Left : Int; Right : Uint) return Boolean is
1560    begin
1561       return not UI_Ne (UI_From_Int (Left), Right);
1562    end UI_Eq;
1563
1564    function UI_Eq (Left : Uint; Right : Int) return Boolean is
1565    begin
1566       return not UI_Ne (Left, UI_From_Int (Right));
1567    end UI_Eq;
1568
1569    function UI_Eq (Left : Uint; Right : Uint) return Boolean is
1570    begin
1571       return not UI_Ne (Left, Right);
1572    end UI_Eq;
1573
1574    --------------
1575    -- UI_Expon --
1576    --------------
1577
1578    function UI_Expon (Left : Int; Right : Uint) return Uint is
1579    begin
1580       return UI_Expon (UI_From_Int (Left), Right);
1581    end UI_Expon;
1582
1583    function UI_Expon (Left : Uint; Right : Int) return Uint is
1584    begin
1585       return UI_Expon (Left, UI_From_Int (Right));
1586    end UI_Expon;
1587
1588    function UI_Expon (Left : Int; Right : Int) return Uint is
1589    begin
1590       return UI_Expon (UI_From_Int (Left), UI_From_Int (Right));
1591    end UI_Expon;
1592
1593    function UI_Expon (Left : Uint; Right : Uint) return Uint is
1594    begin
1595       pragma Assert (Right >= Uint_0);
1596
1597       --  Any value raised to power of 0 is 1
1598
1599       if Right = Uint_0 then
1600          return Uint_1;
1601
1602       --  0 to any positive power is 0
1603
1604       elsif Left = Uint_0 then
1605          return Uint_0;
1606
1607       --  1 to any power is 1
1608
1609       elsif Left = Uint_1 then
1610          return Uint_1;
1611
1612       --  Any value raised to power of 1 is that value
1613
1614       elsif Right = Uint_1 then
1615          return Left;
1616
1617       --  Cases which can be done by table lookup
1618
1619       elsif Right <= Uint_64 then
1620
1621          --  2 ** N for N in 2 .. 64
1622
1623          if Left = Uint_2 then
1624             declare
1625                Right_Int : constant Int := Direct_Val (Right);
1626
1627             begin
1628                if Right_Int > UI_Power_2_Set then
1629                   for J in UI_Power_2_Set + Int_1 .. Right_Int loop
1630                      UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2;
1631                      Uints_Min := Uints.Last;
1632                      Udigits_Min := Udigits.Last;
1633                   end loop;
1634
1635                   UI_Power_2_Set := Right_Int;
1636                end if;
1637
1638                return UI_Power_2 (Right_Int);
1639             end;
1640
1641          --  10 ** N for N in 2 .. 64
1642
1643          elsif Left = Uint_10 then
1644             declare
1645                Right_Int : constant Int := Direct_Val (Right);
1646
1647             begin
1648                if Right_Int > UI_Power_10_Set then
1649                   for J in UI_Power_10_Set + Int_1 .. Right_Int loop
1650                      UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10);
1651                      Uints_Min := Uints.Last;
1652                      Udigits_Min := Udigits.Last;
1653                   end loop;
1654
1655                   UI_Power_10_Set := Right_Int;
1656                end if;
1657
1658                return UI_Power_10 (Right_Int);
1659             end;
1660          end if;
1661       end if;
1662
1663       --  If we fall through, then we have the general case (see Knuth 4.6.3)
1664
1665       declare
1666          N       : Uint := Right;
1667          Squares : Uint := Left;
1668          Result  : Uint := Uint_1;
1669          M       : constant Uintp.Save_Mark := Uintp.Mark;
1670
1671       begin
1672          loop
1673             if (Least_Sig_Digit (N) mod Int_2) = Int_1 then
1674                Result := Result * Squares;
1675             end if;
1676
1677             N := N / Uint_2;
1678             exit when N = Uint_0;
1679             Squares := Squares *  Squares;
1680          end loop;
1681
1682          Uintp.Release_And_Save (M, Result);
1683          return Result;
1684       end;
1685    end UI_Expon;
1686
1687    ----------------
1688    -- UI_From_CC --
1689    ----------------
1690
1691    function UI_From_CC (Input : Char_Code) return Uint is
1692    begin
1693       return UI_From_Dint (Dint (Input));
1694    end UI_From_CC;
1695
1696    ------------------
1697    -- UI_From_Dint --
1698    ------------------
1699
1700    function UI_From_Dint (Input : Dint) return Uint is
1701    begin
1702
1703       if Dint (Min_Direct) <= Input and then Input <= Dint (Max_Direct) then
1704          return Uint (Dint (Uint_Direct_Bias) + Input);
1705
1706       --  For values of larger magnitude, compute digits into a vector and call
1707       --  Vector_To_Uint.
1708
1709       else
1710          declare
1711             Max_For_Dint : constant := 5;
1712             --  Base is defined so that 5 Uint digits is sufficient to hold the
1713             --  largest possible Dint value.
1714
1715             V : UI_Vector (1 .. Max_For_Dint);
1716
1717             Temp_Integer : Dint;
1718
1719          begin
1720             for J in V'Range loop
1721                V (J) := 0;
1722             end loop;
1723
1724             Temp_Integer := Input;
1725
1726             for J in reverse V'Range loop
1727                V (J) := Int (abs (Temp_Integer rem Dint (Base)));
1728                Temp_Integer := Temp_Integer / Dint (Base);
1729             end loop;
1730
1731             return Vector_To_Uint (V, Input < Dint'(0));
1732          end;
1733       end if;
1734    end UI_From_Dint;
1735
1736    -----------------
1737    -- UI_From_Int --
1738    -----------------
1739
1740    function UI_From_Int (Input : Int) return Uint is
1741       U : Uint;
1742
1743    begin
1744       if Min_Direct <= Input and then Input <= Max_Direct then
1745          return Uint (Int (Uint_Direct_Bias) + Input);
1746       end if;
1747
1748       --  If already in the hash table, return entry
1749
1750       U := UI_Ints.Get (Input);
1751
1752       if U /= No_Uint then
1753          return U;
1754       end if;
1755
1756       --  For values of larger magnitude, compute digits into a vector and call
1757       --  Vector_To_Uint.
1758
1759       declare
1760          Max_For_Int : constant := 3;
1761          --  Base is defined so that 3 Uint digits is sufficient to hold the
1762          --  largest possible Int value.
1763
1764          V : UI_Vector (1 .. Max_For_Int);
1765
1766          Temp_Integer : Int;
1767
1768       begin
1769          for J in V'Range loop
1770             V (J) := 0;
1771          end loop;
1772
1773          Temp_Integer := Input;
1774
1775          for J in reverse V'Range loop
1776             V (J) := abs (Temp_Integer rem Base);
1777             Temp_Integer := Temp_Integer / Base;
1778          end loop;
1779
1780          U := Vector_To_Uint (V, Input < Int_0);
1781          UI_Ints.Set (Input, U);
1782          Uints_Min := Uints.Last;
1783          Udigits_Min := Udigits.Last;
1784          return U;
1785       end;
1786    end UI_From_Int;
1787
1788    ------------
1789    -- UI_GCD --
1790    ------------
1791
1792    --  Lehmer's algorithm for GCD
1793
1794    --  The idea is to avoid using multiple precision arithmetic wherever
1795    --  possible, substituting Int arithmetic instead. See Knuth volume II,
1796    --  Algorithm L (page 329).
1797
1798    --  We use the same notation as Knuth (U_Hat standing for the obvious!)
1799
1800    function UI_GCD (Uin, Vin : Uint) return Uint is
1801       U, V : Uint;
1802       --  Copies of Uin and Vin
1803
1804       U_Hat, V_Hat : Int;
1805       --  The most Significant digits of U,V
1806
1807       A, B, C, D, T, Q, Den1, Den2 : Int;
1808
1809       Tmp_UI : Uint;
1810       Marks  : constant Uintp.Save_Mark := Uintp.Mark;
1811       Iterations : Integer := 0;
1812
1813    begin
1814       pragma Assert (Uin >= Vin);
1815       pragma Assert (Vin >= Uint_0);
1816
1817       U := Uin;
1818       V := Vin;
1819
1820       loop
1821          Iterations := Iterations + 1;
1822
1823          if Direct (V) then
1824             if V = Uint_0 then
1825                return U;
1826             else
1827                return
1828                  UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V)));
1829             end if;
1830          end if;
1831
1832          Most_Sig_2_Digits (U, V, U_Hat, V_Hat);
1833          A := 1;
1834          B := 0;
1835          C := 0;
1836          D := 1;
1837
1838          loop
1839             --  We might overflow and get division by zero here. This just
1840             --  means we cannot take the single precision step
1841
1842             Den1 := V_Hat + C;
1843             Den2 := V_Hat + D;
1844             exit when (Den1 * Den2) = Int_0;
1845
1846             --  Compute Q, the trial quotient
1847
1848             Q := (U_Hat + A) / Den1;
1849
1850             exit when Q /= ((U_Hat + B) / Den2);
1851
1852             --  A single precision step Euclid step will give same answer as a
1853             --  multiprecision one.
1854
1855             T := A - (Q * C);
1856             A := C;
1857             C := T;
1858
1859             T := B - (Q * D);
1860             B := D;
1861             D := T;
1862
1863             T := U_Hat - (Q * V_Hat);
1864             U_Hat := V_Hat;
1865             V_Hat := T;
1866
1867          end loop;
1868
1869          --  Take a multiprecision Euclid step
1870
1871          if B = Int_0 then
1872
1873             --  No single precision steps take a regular Euclid step
1874
1875             Tmp_UI := U rem V;
1876             U := V;
1877             V := Tmp_UI;
1878
1879          else
1880             --  Use prior single precision steps to compute this Euclid step
1881
1882             --  For constructs such as:
1883             --  sqrt_2: constant :=  1.41421_35623_73095_04880_16887_24209_698;
1884             --  sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2)
1885             --    ** long_float'machine_mantissa;
1886             --
1887             --  we spend 80% of our time working on this step. Perhaps we need
1888             --  a special case Int / Uint dot product to speed things up. ???
1889
1890             --  Alternatively we could increase the single precision iterations
1891             --  to handle Uint's of some small size ( <5 digits?). Then we
1892             --  would have more iterations on small Uint. On the code above, we
1893             --  only get 5 (on average) single precision iterations per large
1894             --  iteration. ???
1895
1896             Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V);
1897             V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V);
1898             U := Tmp_UI;
1899          end if;
1900
1901          --  If the operands are very different in magnitude, the loop will
1902          --  generate large amounts of short-lived data, which it is worth
1903          --  removing periodically.
1904
1905          if Iterations > 100 then
1906             Release_And_Save (Marks, U, V);
1907             Iterations := 0;
1908          end if;
1909       end loop;
1910    end UI_GCD;
1911
1912    ------------
1913    -- UI_Ge --
1914    ------------
1915
1916    function UI_Ge (Left : Int; Right : Uint) return Boolean is
1917    begin
1918       return not UI_Lt (UI_From_Int (Left), Right);
1919    end UI_Ge;
1920
1921    function UI_Ge (Left : Uint; Right : Int) return Boolean is
1922    begin
1923       return not UI_Lt (Left, UI_From_Int (Right));
1924    end UI_Ge;
1925
1926    function UI_Ge (Left : Uint; Right : Uint) return Boolean is
1927    begin
1928       return not UI_Lt (Left, Right);
1929    end UI_Ge;
1930
1931    ------------
1932    -- UI_Gt --
1933    ------------
1934
1935    function UI_Gt (Left : Int; Right : Uint) return Boolean is
1936    begin
1937       return UI_Lt (Right, UI_From_Int (Left));
1938    end UI_Gt;
1939
1940    function UI_Gt (Left : Uint; Right : Int) return Boolean is
1941    begin
1942       return UI_Lt (UI_From_Int (Right), Left);
1943    end UI_Gt;
1944
1945    function UI_Gt (Left : Uint; Right : Uint) return Boolean is
1946    begin
1947       return UI_Lt (Right, Left);
1948    end UI_Gt;
1949
1950    ---------------
1951    -- UI_Image --
1952    ---------------
1953
1954    procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
1955    begin
1956       Image_Out (Input, True, Format);
1957    end UI_Image;
1958
1959    -------------------------
1960    -- UI_Is_In_Int_Range --
1961    -------------------------
1962
1963    function UI_Is_In_Int_Range (Input : Uint) return Boolean is
1964    begin
1965       --  Make sure we don't get called before Initialize
1966
1967       pragma Assert (Uint_Int_First /= Uint_0);
1968
1969       if Direct (Input) then
1970          return True;
1971       else
1972          return Input >= Uint_Int_First
1973            and then Input <= Uint_Int_Last;
1974       end if;
1975    end UI_Is_In_Int_Range;
1976
1977    ------------
1978    -- UI_Le --
1979    ------------
1980
1981    function UI_Le (Left : Int; Right : Uint) return Boolean is
1982    begin
1983       return not UI_Lt (Right, UI_From_Int (Left));
1984    end UI_Le;
1985
1986    function UI_Le (Left : Uint; Right : Int) return Boolean is
1987    begin
1988       return not UI_Lt (UI_From_Int (Right), Left);
1989    end UI_Le;
1990
1991    function UI_Le (Left : Uint; Right : Uint) return Boolean is
1992    begin
1993       return not UI_Lt (Right, Left);
1994    end UI_Le;
1995
1996    ------------
1997    -- UI_Lt --
1998    ------------
1999
2000    function UI_Lt (Left : Int; Right : Uint) return Boolean is
2001    begin
2002       return UI_Lt (UI_From_Int (Left), Right);
2003    end UI_Lt;
2004
2005    function UI_Lt (Left : Uint; Right : Int) return Boolean is
2006    begin
2007       return UI_Lt (Left, UI_From_Int (Right));
2008    end UI_Lt;
2009
2010    function UI_Lt (Left : Uint; Right : Uint) return Boolean is
2011    begin
2012       --  Quick processing for identical arguments
2013
2014       if Int (Left) = Int (Right) then
2015          return False;
2016
2017       --  Quick processing for both arguments directly represented
2018
2019       elsif Direct (Left) and then Direct (Right) then
2020          return Int (Left) < Int (Right);
2021
2022       --  At least one argument is more than one digit long
2023
2024       else
2025          declare
2026             L_Length : constant Int := N_Digits (Left);
2027             R_Length : constant Int := N_Digits (Right);
2028
2029             L_Vec : UI_Vector (1 .. L_Length);
2030             R_Vec : UI_Vector (1 .. R_Length);
2031
2032          begin
2033             Init_Operand (Left, L_Vec);
2034             Init_Operand (Right, R_Vec);
2035
2036             if L_Vec (1) < Int_0 then
2037
2038                --  First argument negative, second argument non-negative
2039
2040                if R_Vec (1) >= Int_0 then
2041                   return True;
2042
2043                --  Both arguments negative
2044
2045                else
2046                   if L_Length /= R_Length then
2047                      return L_Length > R_Length;
2048
2049                   elsif L_Vec (1) /= R_Vec (1) then
2050                      return L_Vec (1) < R_Vec (1);
2051
2052                   else
2053                      for J in 2 .. L_Vec'Last loop
2054                         if L_Vec (J) /= R_Vec (J) then
2055                            return L_Vec (J) > R_Vec (J);
2056                         end if;
2057                      end loop;
2058
2059                      return False;
2060                   end if;
2061                end if;
2062
2063             else
2064                --  First argument non-negative, second argument negative
2065
2066                if R_Vec (1) < Int_0 then
2067                   return False;
2068
2069                --  Both arguments non-negative
2070
2071                else
2072                   if L_Length /= R_Length then
2073                      return L_Length < R_Length;
2074                   else
2075                      for J in L_Vec'Range loop
2076                         if L_Vec (J) /= R_Vec (J) then
2077                            return L_Vec (J) < R_Vec (J);
2078                         end if;
2079                      end loop;
2080
2081                      return False;
2082                   end if;
2083                end if;
2084             end if;
2085          end;
2086       end if;
2087    end UI_Lt;
2088
2089    ------------
2090    -- UI_Max --
2091    ------------
2092
2093    function UI_Max (Left : Int; Right : Uint) return Uint is
2094    begin
2095       return UI_Max (UI_From_Int (Left), Right);
2096    end UI_Max;
2097
2098    function UI_Max (Left : Uint; Right : Int) return Uint is
2099    begin
2100       return UI_Max (Left, UI_From_Int (Right));
2101    end UI_Max;
2102
2103    function UI_Max (Left : Uint; Right : Uint) return Uint is
2104    begin
2105       if Left >= Right then
2106          return Left;
2107       else
2108          return Right;
2109       end if;
2110    end UI_Max;
2111
2112    ------------
2113    -- UI_Min --
2114    ------------
2115
2116    function UI_Min (Left : Int; Right : Uint) return Uint is
2117    begin
2118       return UI_Min (UI_From_Int (Left), Right);
2119    end UI_Min;
2120
2121    function UI_Min (Left : Uint; Right : Int) return Uint is
2122    begin
2123       return UI_Min (Left, UI_From_Int (Right));
2124    end UI_Min;
2125
2126    function UI_Min (Left : Uint; Right : Uint) return Uint is
2127    begin
2128       if Left <= Right then
2129          return Left;
2130       else
2131          return Right;
2132       end if;
2133    end UI_Min;
2134
2135    -------------
2136    -- UI_Mod --
2137    -------------
2138
2139    function UI_Mod (Left : Int; Right : Uint) return Uint is
2140    begin
2141       return UI_Mod (UI_From_Int (Left), Right);
2142    end UI_Mod;
2143
2144    function UI_Mod (Left : Uint; Right : Int) return Uint is
2145    begin
2146       return UI_Mod (Left, UI_From_Int (Right));
2147    end UI_Mod;
2148
2149    function UI_Mod (Left : Uint; Right : Uint) return Uint is
2150       Urem : constant Uint := Left rem Right;
2151
2152    begin
2153       if (Left < Uint_0) = (Right < Uint_0)
2154         or else Urem = Uint_0
2155       then
2156          return Urem;
2157       else
2158          return Right + Urem;
2159       end if;
2160    end UI_Mod;
2161
2162    -------------------------------
2163    -- UI_Modular_Exponentiation --
2164    -------------------------------
2165
2166    function UI_Modular_Exponentiation
2167      (B      : Uint;
2168       E      : Uint;
2169       Modulo : Uint) return Uint
2170    is
2171       M : constant Save_Mark := Mark;
2172
2173       Result   : Uint := Uint_1;
2174       Base     : Uint := B;
2175       Exponent : Uint := E;
2176
2177    begin
2178       while Exponent /= Uint_0 loop
2179          if Least_Sig_Digit (Exponent) rem Int'(2) = Int'(1) then
2180             Result := (Result * Base) rem Modulo;
2181          end if;
2182
2183          Exponent := Exponent / Uint_2;
2184          Base := (Base * Base) rem Modulo;
2185       end loop;
2186
2187       Release_And_Save (M, Result);
2188       return Result;
2189    end UI_Modular_Exponentiation;
2190
2191    ------------------------
2192    -- UI_Modular_Inverse --
2193    ------------------------
2194
2195    function UI_Modular_Inverse (N : Uint; Modulo : Uint) return Uint is
2196       M : constant Save_Mark := Mark;
2197       U : Uint;
2198       V : Uint;
2199       Q : Uint;
2200       R : Uint;
2201       X : Uint;
2202       Y : Uint;
2203       T : Uint;
2204       S : Int := 1;
2205
2206    begin
2207       U := Modulo;
2208       V := N;
2209
2210       X := Uint_1;
2211       Y := Uint_0;
2212
2213       loop
2214          UI_Div_Rem
2215            (U, V,
2216             Quotient => Q, Remainder => R,
2217             Discard_Quotient  => False,
2218             Discard_Remainder => False);
2219
2220          U := V;
2221          V := R;
2222
2223          T := X;
2224          X := Y + Q * X;
2225          Y := T;
2226          S := -S;
2227
2228          exit when R = Uint_1;
2229       end loop;
2230
2231       if S = Int'(-1) then
2232          X := Modulo - X;
2233       end if;
2234
2235       Release_And_Save (M, X);
2236       return X;
2237    end UI_Modular_Inverse;
2238
2239    ------------
2240    -- UI_Mul --
2241    ------------
2242
2243    function UI_Mul (Left : Int; Right : Uint) return Uint is
2244    begin
2245       return UI_Mul (UI_From_Int (Left), Right);
2246    end UI_Mul;
2247
2248    function UI_Mul (Left : Uint; Right : Int) return Uint is
2249    begin
2250       return UI_Mul (Left, UI_From_Int (Right));
2251    end UI_Mul;
2252
2253    function UI_Mul (Left : Uint; Right : Uint) return Uint is
2254    begin
2255       --  Simple case of single length operands
2256
2257       if Direct (Left) and then Direct (Right) then
2258          return
2259            UI_From_Dint
2260              (Dint (Direct_Val (Left)) * Dint (Direct_Val (Right)));
2261       end if;
2262
2263       --  Otherwise we have the general case (Algorithm M in Knuth)
2264
2265       declare
2266          L_Length : constant Int := N_Digits (Left);
2267          R_Length : constant Int := N_Digits (Right);
2268          L_Vec    : UI_Vector (1 .. L_Length);
2269          R_Vec    : UI_Vector (1 .. R_Length);
2270          Neg      : Boolean;
2271
2272       begin
2273          Init_Operand (Left, L_Vec);
2274          Init_Operand (Right, R_Vec);
2275          Neg := (L_Vec (1) < Int_0) xor (R_Vec (1) < Int_0);
2276          L_Vec (1) := abs (L_Vec (1));
2277          R_Vec (1) := abs (R_Vec (1));
2278
2279          Algorithm_M : declare
2280             Product : UI_Vector (1 .. L_Length + R_Length);
2281             Tmp_Sum : Int;
2282             Carry   : Int;
2283
2284          begin
2285             for J in Product'Range loop
2286                Product (J) := 0;
2287             end loop;
2288
2289             for J in reverse R_Vec'Range loop
2290                Carry := 0;
2291                for K in reverse L_Vec'Range loop
2292                   Tmp_Sum :=
2293                     L_Vec (K) * R_Vec (J) + Product (J + K) + Carry;
2294                   Product (J + K) := Tmp_Sum rem Base;
2295                   Carry := Tmp_Sum / Base;
2296                end loop;
2297
2298                Product (J) := Carry;
2299             end loop;
2300
2301             return Vector_To_Uint (Product, Neg);
2302          end Algorithm_M;
2303       end;
2304    end UI_Mul;
2305
2306    ------------
2307    -- UI_Ne --
2308    ------------
2309
2310    function UI_Ne (Left : Int; Right : Uint) return Boolean is
2311    begin
2312       return UI_Ne (UI_From_Int (Left), Right);
2313    end UI_Ne;
2314
2315    function UI_Ne (Left : Uint; Right : Int) return Boolean is
2316    begin
2317       return UI_Ne (Left, UI_From_Int (Right));
2318    end UI_Ne;
2319
2320    function UI_Ne (Left : Uint; Right : Uint) return Boolean is
2321    begin
2322       --  Quick processing for identical arguments. Note that this takes
2323       --  care of the case of two No_Uint arguments.
2324
2325       if Int (Left) = Int (Right) then
2326          return False;
2327       end if;
2328
2329       --  See if left operand directly represented
2330
2331       if Direct (Left) then
2332
2333          --  If right operand directly represented then compare
2334
2335          if Direct (Right) then
2336             return Int (Left) /= Int (Right);
2337
2338          --  Left operand directly represented, right not, must be unequal
2339
2340          else
2341             return True;
2342          end if;
2343
2344       --  Right operand directly represented, left not, must be unequal
2345
2346       elsif Direct (Right) then
2347          return True;
2348       end if;
2349
2350       --  Otherwise both multi-word, do comparison
2351
2352       declare
2353          Size      : constant Int := N_Digits (Left);
2354          Left_Loc  : Int;
2355          Right_Loc : Int;
2356
2357       begin
2358          if Size /= N_Digits (Right) then
2359             return True;
2360          end if;
2361
2362          Left_Loc  := Uints.Table (Left).Loc;
2363          Right_Loc := Uints.Table (Right).Loc;
2364
2365          for J in Int_0 .. Size - Int_1 loop
2366             if Udigits.Table (Left_Loc + J) /=
2367                Udigits.Table (Right_Loc + J)
2368             then
2369                return True;
2370             end if;
2371          end loop;
2372
2373          return False;
2374       end;
2375    end UI_Ne;
2376
2377    ----------------
2378    -- UI_Negate --
2379    ----------------
2380
2381    function UI_Negate (Right : Uint) return Uint is
2382    begin
2383       --  Case where input is directly represented. Note that since the range
2384       --  of Direct values is non-symmetrical, the result may not be directly
2385       --  represented, this is taken care of in UI_From_Int.
2386
2387       if Direct (Right) then
2388          return UI_From_Int (-Direct_Val (Right));
2389
2390       --  Full processing for multi-digit case. Note that we cannot just copy
2391       --  the value to the end of the table negating the first digit, since the
2392       --  range of Direct values is non-symmetrical, so we can have a negative
2393       --  value that is not Direct whose negation can be represented directly.
2394
2395       else
2396          declare
2397             R_Length : constant Int := N_Digits (Right);
2398             R_Vec    : UI_Vector (1 .. R_Length);
2399             Neg      : Boolean;
2400
2401          begin
2402             Init_Operand (Right, R_Vec);
2403             Neg := R_Vec (1) > Int_0;
2404             R_Vec (1) := abs R_Vec (1);
2405             return Vector_To_Uint (R_Vec, Neg);
2406          end;
2407       end if;
2408    end UI_Negate;
2409
2410    -------------
2411    -- UI_Rem --
2412    -------------
2413
2414    function UI_Rem (Left : Int; Right : Uint) return Uint is
2415    begin
2416       return UI_Rem (UI_From_Int (Left), Right);
2417    end UI_Rem;
2418
2419    function UI_Rem (Left : Uint; Right : Int) return Uint is
2420    begin
2421       return UI_Rem (Left, UI_From_Int (Right));
2422    end UI_Rem;
2423
2424    function UI_Rem (Left, Right : Uint) return Uint is
2425       Sign : Int;
2426       Tmp  : Int;
2427
2428       subtype Int1_12 is Integer range 1 .. 12;
2429
2430    begin
2431       pragma Assert (Right /= Uint_0);
2432
2433       if Direct (Right) then
2434          if Direct (Left) then
2435             return UI_From_Int (Direct_Val (Left) rem Direct_Val (Right));
2436
2437          else
2438
2439             --  Special cases when Right is less than 13 and Left is larger
2440             --  larger than one digit. All of these algorithms depend on the
2441             --  base being 2 ** 15 We work with Abs (Left) and Abs(Right)
2442             --  then multiply result by Sign (Left)
2443
2444             if (Right <= Uint_12) and then (Right >= Uint_Minus_12) then
2445
2446                if Left < Uint_0 then
2447                   Sign := -1;
2448                else
2449                   Sign := 1;
2450                end if;
2451
2452                --  All cases are listed, grouped by mathematical method It is
2453                --  not inefficient to do have this case list out of order since
2454                --  GCC sorts the cases we list.
2455
2456                case Int1_12 (abs (Direct_Val (Right))) is
2457
2458                   when 1 =>
2459                      return Uint_0;
2460
2461                   --  Powers of two are simple AND's with LS Left Digit GCC
2462                   --  will recognise these constants as powers of 2 and replace
2463                   --  the rem with simpler operations where possible.
2464
2465                   --  Least_Sig_Digit might return Negative numbers
2466
2467                   when 2 =>
2468                      return UI_From_Int (
2469                         Sign * (Least_Sig_Digit (Left) mod 2));
2470
2471                   when 4 =>
2472                      return UI_From_Int (
2473                         Sign * (Least_Sig_Digit (Left) mod 4));
2474
2475                   when 8 =>
2476                      return UI_From_Int (
2477                         Sign * (Least_Sig_Digit (Left) mod 8));
2478
2479                   --  Some number theoretical tricks:
2480
2481                   --    If B Rem Right = 1 then
2482                   --    Left Rem Right = Sum_Of_Digits_Base_B (Left) Rem Right
2483
2484                   --  Note: 2^32 mod 3 = 1
2485
2486                   when 3 =>
2487                      return UI_From_Int (
2488                         Sign * (Sum_Double_Digits (Left, 1) rem Int (3)));
2489
2490                   --  Note: 2^15 mod 7 = 1
2491
2492                   when 7 =>
2493                      return UI_From_Int (
2494                         Sign * (Sum_Digits (Left, 1) rem Int (7)));
2495
2496                   --  Note: 2^32 mod 5 = -1
2497
2498                   --  Alternating sums might be negative, but rem is always
2499                   --  positive hence we must use mod here.
2500
2501                   when 5 =>
2502                      Tmp := Sum_Double_Digits (Left, -1) mod Int (5);
2503                      return UI_From_Int (Sign * Tmp);
2504
2505                   --  Note: 2^15 mod 9 = -1
2506
2507                   --  Alternating sums might be negative, but rem is always
2508                   --  positive hence we must use mod here.
2509
2510                   when 9  =>
2511                      Tmp := Sum_Digits (Left, -1) mod Int (9);
2512                      return UI_From_Int (Sign * Tmp);
2513
2514                   --  Note: 2^15 mod 11 = -1
2515
2516                   --  Alternating sums might be negative, but rem is always
2517                   --  positive hence we must use mod here.
2518
2519                   when 11 =>
2520                      Tmp := Sum_Digits (Left, -1) mod Int (11);
2521                      return UI_From_Int (Sign * Tmp);
2522
2523                   --  Now resort to Chinese Remainder theorem to reduce 6, 10,
2524                   --  12 to previous special cases
2525
2526                   --  There is no reason we could not add more cases like these
2527                   --  if it proves useful.
2528
2529                   --  Perhaps we should go up to 16, however we have no "trick"
2530                   --  for 13.
2531
2532                   --  To find u mod m we:
2533
2534                   --  Pick m1, m2 S.T.
2535                   --     GCD(m1, m2) = 1 AND m = (m1 * m2).
2536
2537                   --  Next we pick (Basis) M1, M2 small S.T.
2538                   --     (M1 mod m1) = (M2 mod m2) = 1 AND
2539                   --     (M1 mod m2) = (M2 mod m1) = 0
2540
2541                   --  So u mod m = (u1 * M1 + u2 * M2) mod m Where u1 = (u mod
2542                   --  m1) AND u2 = (u mod m2); Under typical circumstances the
2543                   --  last mod m can be done with a (possible) single
2544                   --  subtraction.
2545
2546                   --  m1 = 2; m2 = 3; M1 = 3; M2 = 4;
2547
2548                   when 6  =>
2549                      Tmp := 3 * (Least_Sig_Digit (Left) rem 2) +
2550                               4 * (Sum_Double_Digits (Left, 1) rem 3);
2551                      return UI_From_Int (Sign * (Tmp rem 6));
2552
2553                   --  m1 = 2; m2 = 5; M1 = 5; M2 = 6;
2554
2555                   when 10 =>
2556                      Tmp := 5 * (Least_Sig_Digit (Left) rem 2) +
2557                               6 * (Sum_Double_Digits (Left, -1) mod 5);
2558                      return UI_From_Int (Sign * (Tmp rem 10));
2559
2560                   --  m1 = 3; m2 = 4; M1 = 4; M2 = 9;
2561
2562                   when 12 =>
2563                      Tmp := 4 * (Sum_Double_Digits (Left, 1) rem 3) +
2564                               9 * (Least_Sig_Digit (Left) rem 4);
2565                      return UI_From_Int (Sign * (Tmp rem 12));
2566                end case;
2567
2568             end if;
2569
2570             --  Else fall through to general case
2571
2572             --  The special case Length (Left) = Length (Right) = 1 in Div
2573             --  looks slow. It uses UI_To_Int when Int should suffice. ???
2574          end if;
2575       end if;
2576
2577       declare
2578          Remainder : Uint;
2579          Quotient  : Uint;
2580          pragma Warnings (Off, Quotient);
2581       begin
2582          UI_Div_Rem
2583            (Left, Right, Quotient, Remainder,
2584             Discard_Quotient  => True,
2585             Discard_Remainder => False);
2586          return Remainder;
2587       end;
2588    end UI_Rem;
2589
2590    ------------
2591    -- UI_Sub --
2592    ------------
2593
2594    function UI_Sub (Left : Int; Right : Uint) return Uint is
2595    begin
2596       return UI_Add (Left, -Right);
2597    end UI_Sub;
2598
2599    function UI_Sub (Left : Uint; Right : Int) return Uint is
2600    begin
2601       return UI_Add (Left, -Right);
2602    end UI_Sub;
2603
2604    function UI_Sub (Left : Uint; Right : Uint) return Uint is
2605    begin
2606       if Direct (Left) and then Direct (Right) then
2607          return UI_From_Int (Direct_Val (Left) - Direct_Val (Right));
2608       else
2609          return UI_Add (Left, -Right);
2610       end if;
2611    end UI_Sub;
2612
2613    --------------
2614    -- UI_To_CC --
2615    --------------
2616
2617    function UI_To_CC (Input : Uint) return Char_Code is
2618    begin
2619       if Direct (Input) then
2620          return Char_Code (Direct_Val (Input));
2621
2622       --  Case of input is more than one digit
2623
2624       else
2625          declare
2626             In_Length : constant Int := N_Digits (Input);
2627             In_Vec    : UI_Vector (1 .. In_Length);
2628             Ret_CC    : Char_Code;
2629
2630          begin
2631             Init_Operand (Input, In_Vec);
2632
2633             --  We assume value is positive
2634
2635             Ret_CC := 0;
2636             for Idx in In_Vec'Range loop
2637                Ret_CC := Ret_CC * Char_Code (Base) +
2638                                   Char_Code (abs In_Vec (Idx));
2639             end loop;
2640
2641             return Ret_CC;
2642          end;
2643       end if;
2644    end UI_To_CC;
2645
2646    ----------------
2647    -- UI_To_Int --
2648    ----------------
2649
2650    function UI_To_Int (Input : Uint) return Int is
2651    begin
2652       if Direct (Input) then
2653          return Direct_Val (Input);
2654
2655       --  Case of input is more than one digit
2656
2657       else
2658          declare
2659             In_Length : constant Int := N_Digits (Input);
2660             In_Vec    : UI_Vector (1 .. In_Length);
2661             Ret_Int   : Int;
2662
2663          begin
2664             --  Uints of more than one digit could be outside the range for
2665             --  Ints. Caller should have checked for this if not certain.
2666             --  Fatal error to attempt to convert from value outside Int'Range.
2667
2668             pragma Assert (UI_Is_In_Int_Range (Input));
2669
2670             --  Otherwise, proceed ahead, we are OK
2671
2672             Init_Operand (Input, In_Vec);
2673             Ret_Int := 0;
2674
2675             --  Calculate -|Input| and then negates if value is positive. This
2676             --  handles our current definition of Int (based on 2s complement).
2677             --  Is it secure enough???
2678
2679             for Idx in In_Vec'Range loop
2680                Ret_Int := Ret_Int * Base - abs In_Vec (Idx);
2681             end loop;
2682
2683             if In_Vec (1) < Int_0 then
2684                return Ret_Int;
2685             else
2686                return -Ret_Int;
2687             end if;
2688          end;
2689       end if;
2690    end UI_To_Int;
2691
2692    --------------
2693    -- UI_Write --
2694    --------------
2695
2696    procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is
2697    begin
2698       Image_Out (Input, False, Format);
2699    end UI_Write;
2700
2701    ---------------------
2702    -- Vector_To_Uint --
2703    ---------------------
2704
2705    function Vector_To_Uint
2706      (In_Vec   : UI_Vector;
2707       Negative : Boolean)
2708       return     Uint
2709    is
2710       Size : Int;
2711       Val  : Int;
2712
2713    begin
2714       --  The vector can contain leading zeros. These are not stored in the
2715       --  table, so loop through the vector looking for first non-zero digit
2716
2717       for J in In_Vec'Range loop
2718          if In_Vec (J) /= Int_0 then
2719
2720             --  The length of the value is the length of the rest of the vector
2721
2722             Size := In_Vec'Last - J + 1;
2723
2724             --  One digit value can always be represented directly
2725
2726             if Size = Int_1 then
2727                if Negative then
2728                   return Uint (Int (Uint_Direct_Bias) - In_Vec (J));
2729                else
2730                   return Uint (Int (Uint_Direct_Bias) + In_Vec (J));
2731                end if;
2732
2733             --  Positive two digit values may be in direct representation range
2734
2735             elsif Size = Int_2 and then not Negative then
2736                Val := In_Vec (J) * Base + In_Vec (J + 1);
2737
2738                if Val <= Max_Direct then
2739                   return Uint (Int (Uint_Direct_Bias) + Val);
2740                end if;
2741             end if;
2742
2743             --  The value is outside the direct representation range and must
2744             --  therefore be stored in the table. Expand the table to contain
2745             --  the count and tigis. The index of the new table entry will be
2746             --  returned as the result.
2747
2748             Uints.Increment_Last;
2749             Uints.Table (Uints.Last).Length := Size;
2750             Uints.Table (Uints.Last).Loc    := Udigits.Last + 1;
2751
2752             Udigits.Increment_Last;
2753
2754             if Negative then
2755                Udigits.Table (Udigits.Last) := -In_Vec (J);
2756             else
2757                Udigits.Table (Udigits.Last) := +In_Vec (J);
2758             end if;
2759
2760             for K in 2 .. Size loop
2761                Udigits.Increment_Last;
2762                Udigits.Table (Udigits.Last) := In_Vec (J + K - 1);
2763             end loop;
2764
2765             return Uints.Last;
2766          end if;
2767       end loop;
2768
2769       --  Dropped through loop only if vector contained all zeros
2770
2771       return Uint_0;
2772    end Vector_To_Uint;
2773
2774 end Uintp;