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