gcc/ada/uintp.adb

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