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