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