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