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