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