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