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