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