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
1169          begin
1170             --  [ NORMALIZE ] (step D1 in the algorithm). First calculate the
1171             --  scale d, and then multiply Left and Right (u and v in the book)
1172             --  by d to get the dividend and divisor to work with.
1173
1174             D := Base / (abs R_Vec (1) + 1);
1175
1176             Dividend (1) := 0;
1177             Dividend (2) := abs L_Vec (1);
1178
1179             for J in 3 .. L_Length + Int_1 loop
1180                Dividend (J) := L_Vec (J - 1);
1181             end loop;
1182
1183             Divisor (1) := abs R_Vec (1);
1184
1185             for J in Int_2 .. R_Length loop
1186                Divisor (J) := R_Vec (J);
1187             end loop;
1188
1189             if D > Int_1 then
1190
1191                --  Multiply Dividend by d
1192
1193                Carry := 0;
1194                for J in reverse Dividend'Range loop
1195                   Tmp_Int      := Dividend (J) * D + Carry;
1196                   Dividend (J) := Tmp_Int rem Base;
1197                   Carry        := Tmp_Int / Base;
1198                end loop;
1199
1200                --  Multiply Divisor by d
1201
1202                Carry := 0;
1203                for J in reverse Divisor'Range loop
1204                   Tmp_Int      := Divisor (J) * D + Carry;
1205                   Divisor (J)  := Tmp_Int rem Base;
1206                   Carry        := Tmp_Int / Base;
1207                end loop;
1208             end if;
1209
1210             --  Main loop of long division algorithm
1211
1212             Divisor_Dig1 := Divisor (1);
1213             Divisor_Dig2 := Divisor (2);
1214
1215             for J in Quotient_V'Range loop
1216
1217                --  [ CALCULATE Q (hat) ] (step D3 in the algorithm)
1218
1219                Tmp_Int := Dividend (J) * Base + Dividend (J + 1);
1220
1221                --  Initial guess
1222
1223                if Dividend (J) = Divisor_Dig1 then
1224                   Q_Guess := Base - 1;
1225                else
1226                   Q_Guess := Tmp_Int / Divisor_Dig1;
1227                end if;
1228
1229                --  Refine the guess
1230
1231                while Divisor_Dig2 * Q_Guess >
1232                      (Tmp_Int - Q_Guess * Divisor_Dig1) * Base +
1233                                                           Dividend (J + 2)
1234                loop
1235                   Q_Guess := Q_Guess - 1;
1236                end loop;
1237
1238                --  [ MULTIPLY & SUBTRACT ] (step D4). Q_Guess * Divisor is
1239                --  subtracted from the remaining dividend.
1240
1241                Carry := 0;
1242                for K in reverse Divisor'Range loop
1243                   Tmp_Int := Dividend (J + K) - Q_Guess * Divisor (K) + Carry;
1244                   Tmp_Dig := Tmp_Int rem Base;
1245                   Carry   := Tmp_Int / Base;
1246
1247                   if Tmp_Dig < Int_0 then
1248                      Tmp_Dig := Tmp_Dig + Base;
1249                      Carry   := Carry - 1;
1250                   end if;
1251
1252                   Dividend (J + K) := Tmp_Dig;
1253                end loop;
1254
1255                Dividend (J) := Dividend (J) + Carry;
1256
1257                --  [ TEST REMAINDER ] & [ ADD BACK ] (steps D5 and D6)
1258
1259                --  Here there is a slight difference from the book: the last
1260                --  carry is always added in above and below (cancelling each
1261                --  other). In fact the dividend going negative is used as
1262                --  the test.
1263
1264                --  If the Dividend went negative, then Q_Guess was off by
1265                --  one, so it is decremented, and the divisor is added back
1266                --  into the relevant portion of the dividend.
1267
1268                if Dividend (J) < Int_0 then
1269                   Q_Guess := Q_Guess - 1;
1270
1271                   Carry := 0;
1272                   for K in reverse Divisor'Range loop
1273                      Tmp_Int := Dividend (J + K) + Divisor (K) + Carry;
1274
1275                      if Tmp_Int >= Base then
1276                         Tmp_Int := Tmp_Int - Base;
1277                         Carry := 1;
1278                      else
1279                         Carry := 0;
1280                      end if;
1281
1282                      Dividend (J + K) := Tmp_Int;
1283                   end loop;
1284
1285                   Dividend (J) := Dividend (J) + Carry;
1286                end if;
1287
1288                --  Finally we can get the next quotient digit
1289
1290                Quotient_V (J) := Q_Guess;
1291             end loop;
1292
1293             --  [ UNNORMALIZE ] (step D8)
1294
1295             if not Discard_Quotient then
1296                Quotient := Vector_To_Uint
1297                  (Quotient_V, (L_Vec (1) < Int_0 xor R_Vec (1) < Int_0));
1298             end if;
1299
1300             if not Discard_Remainder then
1301                declare
1302                   Remainder_V : UI_Vector (1 .. R_Length);
1303                   Discard_Int : Int;
1304                   pragma Warnings (Off, Discard_Int);
1305                begin
1306                   UI_Div_Vector
1307                     (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last),
1308                      D,
1309                      Remainder_V, Discard_Int);
1310                   Remainder := Vector_To_Uint (Remainder_V, L_Vec (1) < Int_0);
1311                end;
1312             end if;
1313          end Algorithm_D;
1314       end;
1315    end UI_Div_Rem;
1316
1317    ------------
1318    -- UI_Eq --
1319    ------------
1320
1321    function UI_Eq (Left : Int; Right : Uint) return Boolean is
1322    begin
1323       return not UI_Ne (UI_From_Int (Left), Right);
1324    end UI_Eq;
1325
1326    function UI_Eq (Left : Uint; Right : Int) return Boolean is
1327    begin
1328       return not UI_Ne (Left, UI_From_Int (Right));
1329    end UI_Eq;
1330
1331    function UI_Eq (Left : Uint; Right : Uint) return Boolean is
1332    begin
1333       return not UI_Ne (Left, Right);
1334    end UI_Eq;
1335
1336    --------------
1337    -- UI_Expon --
1338    --------------
1339
1340    function UI_Expon (Left : Int; Right : Uint) return Uint is
1341    begin
1342       return UI_Expon (UI_From_Int (Left), Right);
1343    end UI_Expon;
1344
1345    function UI_Expon (Left : Uint; Right : Int) return Uint is
1346    begin
1347       return UI_Expon (Left, UI_From_Int (Right));
1348    end UI_Expon;
1349
1350    function UI_Expon (Left : Int; Right : Int) return Uint is
1351    begin
1352       return UI_Expon (UI_From_Int (Left), UI_From_Int (Right));
1353    end UI_Expon;
1354
1355    function UI_Expon (Left : Uint; Right : Uint) return Uint is
1356    begin
1357       pragma Assert (Right >= Uint_0);
1358
1359       --  Any value raised to power of 0 is 1
1360
1361       if Right = Uint_0 then
1362          return Uint_1;
1363
1364       --  0 to any positive power is 0
1365
1366       elsif Left = Uint_0 then
1367          return Uint_0;
1368
1369       --  1 to any power is 1
1370
1371       elsif Left = Uint_1 then
1372          return Uint_1;
1373
1374       --  Any value raised to power of 1 is that value
1375
1376       elsif Right = Uint_1 then
1377          return Left;
1378
1379       --  Cases which can be done by table lookup
1380
1381       elsif Right <= Uint_64 then
1382
1383          --  2 ** N for N in 2 .. 64
1384
1385          if Left = Uint_2 then
1386             declare
1387                Right_Int : constant Int := Direct_Val (Right);
1388
1389             begin
1390                if Right_Int > UI_Power_2_Set then
1391                   for J in UI_Power_2_Set + Int_1 .. Right_Int loop
1392                      UI_Power_2 (J) := UI_Power_2 (J - Int_1) * Int_2;
1393                      Uints_Min := Uints.Last;
1394                      Udigits_Min := Udigits.Last;
1395                   end loop;
1396
1397                   UI_Power_2_Set := Right_Int;
1398                end if;
1399
1400                return UI_Power_2 (Right_Int);
1401             end;
1402
1403          --  10 ** N for N in 2 .. 64
1404
1405          elsif Left = Uint_10 then
1406             declare
1407                Right_Int : constant Int := Direct_Val (Right);
1408
1409             begin
1410                if Right_Int > UI_Power_10_Set then
1411                   for J in UI_Power_10_Set + Int_1 .. Right_Int loop
1412                      UI_Power_10 (J) := UI_Power_10 (J - Int_1) * Int (10);
1413                      Uints_Min := Uints.Last;
1414                      Udigits_Min := Udigits.Last;
1415                   end loop;
1416
1417                   UI_Power_10_Set := Right_Int;
1418                end if;
1419
1420                return UI_Power_10 (Right_Int);
1421             end;
1422          end if;
1423       end if;
1424
1425       --  If we fall through, then we have the general case (see Knuth 4.6.3)
1426
1427       declare
1428          N       : Uint := Right;
1429          Squares : Uint := Left;
1430          Result  : Uint := Uint_1;
1431          M       : constant Uintp.Save_Mark := Uintp.Mark;
1432
1433       begin
1434          loop
1435             if (Least_Sig_Digit (N) mod Int_2) = Int_1 then
1436                Result := Result * Squares;
1437             end if;
1438
1439             N := N / Uint_2;
1440             exit when N = Uint_0;
1441             Squares := Squares *  Squares;
1442          end loop;
1443
1444          Uintp.Release_And_Save (M, Result);
1445          return Result;
1446       end;
1447    end UI_Expon;
1448
1449    ----------------
1450    -- UI_From_CC --
1451    ----------------
1452
1453    function UI_From_CC (Input : Char_Code) return Uint is
1454    begin
1455       return UI_From_Int (Int (Input));
1456    end UI_From_CC;
1457
1458    -----------------
1459    -- UI_From_Int --
1460    -----------------
1461
1462    function UI_From_Int (Input : Int) return Uint is
1463       U : Uint;
1464
1465    begin
1466       if Min_Direct <= Input and then Input <= Max_Direct then
1467          return Uint (Int (Uint_Direct_Bias) + Input);
1468       end if;
1469
1470       --  If already in the hash table, return entry
1471
1472       U := UI_Ints.Get (Input);
1473
1474       if U /= No_Uint then
1475          return U;
1476       end if;
1477
1478       --  For values of larger magnitude, compute digits into a vector and call
1479       --  Vector_To_Uint.
1480
1481       declare
1482          Max_For_Int : constant := 3;
1483          --  Base is defined so that 3 Uint digits is sufficient to hold the
1484          --  largest possible Int value.
1485
1486          V : UI_Vector (1 .. Max_For_Int);
1487
1488          Temp_Integer : Int := Input;
1489
1490       begin
1491          for J in reverse V'Range loop
1492             V (J) := abs (Temp_Integer rem Base);
1493             Temp_Integer := Temp_Integer / Base;
1494          end loop;
1495
1496          U := Vector_To_Uint (V, Input < Int_0);
1497          UI_Ints.Set (Input, U);
1498          Uints_Min := Uints.Last;
1499          Udigits_Min := Udigits.Last;
1500          return U;
1501       end;
1502    end UI_From_Int;
1503
1504    ------------
1505    -- UI_GCD --
1506    ------------
1507
1508    --  Lehmer's algorithm for GCD
1509
1510    --  The idea is to avoid using multiple precision arithmetic wherever
1511    --  possible, substituting Int arithmetic instead. See Knuth volume II,
1512    --  Algorithm L (page 329).
1513
1514    --  We use the same notation as Knuth (U_Hat standing for the obvious!)
1515
1516    function UI_GCD (Uin, Vin : Uint) return Uint is
1517       U, V : Uint;
1518       --  Copies of Uin and Vin
1519
1520       U_Hat, V_Hat : Int;
1521       --  The most Significant digits of U,V
1522
1523       A, B, C, D, T, Q, Den1, Den2 : Int;
1524
1525       Tmp_UI : Uint;
1526       Marks  : constant Uintp.Save_Mark := Uintp.Mark;
1527       Iterations : Integer := 0;
1528
1529    begin
1530       pragma Assert (Uin >= Vin);
1531       pragma Assert (Vin >= Uint_0);
1532
1533       U := Uin;
1534       V := Vin;
1535
1536       loop
1537          Iterations := Iterations + 1;
1538
1539          if Direct (V) then
1540             if V = Uint_0 then
1541                return U;
1542             else
1543                return
1544                  UI_From_Int (GCD (Direct_Val (V), UI_To_Int (U rem V)));
1545             end if;
1546          end if;
1547
1548          Most_Sig_2_Digits (U, V, U_Hat, V_Hat);
1549          A := 1;
1550          B := 0;
1551          C := 0;
1552          D := 1;
1553
1554          loop
1555             --  We might overflow and get division by zero here. This just
1556             --  means we cannot take the single precision step
1557
1558             Den1 := V_Hat + C;
1559             Den2 := V_Hat + D;
1560             exit when Den1 = Int_0 or else Den2 = Int_0;
1561
1562             --  Compute Q, the trial quotient
1563
1564             Q := (U_Hat + A) / Den1;
1565
1566             exit when Q /= ((U_Hat + B) / Den2);
1567
1568             --  A single precision step Euclid step will give same answer as a
1569             --  multiprecision one.
1570
1571             T := A - (Q * C);
1572             A := C;
1573             C := T;
1574
1575             T := B - (Q * D);
1576             B := D;
1577             D := T;
1578
1579             T := U_Hat - (Q * V_Hat);
1580             U_Hat := V_Hat;
1581             V_Hat := T;
1582
1583          end loop;
1584
1585          --  Take a multiprecision Euclid step
1586
1587          if B = Int_0 then
1588
1589             --  No single precision steps take a regular Euclid step
1590
1591             Tmp_UI := U rem V;
1592             U := V;
1593             V := Tmp_UI;
1594
1595          else
1596             --  Use prior single precision steps to compute this Euclid step
1597
1598             --  For constructs such as:
1599             --  sqrt_2: constant :=  1.41421_35623_73095_04880_16887_24209_698;
1600             --  sqrt_eps: constant long_float := long_float( 1.0 / sqrt_2)
1601             --    ** long_float'machine_mantissa;
1602             --
1603             --  we spend 80% of our time working on this step. Perhaps we need
1604             --  a special case Int / Uint dot product to speed things up. ???
1605
1606             --  Alternatively we could increase the single precision iterations
1607             --  to handle Uint's of some small size ( <5 digits?). Then we
1608             --  would have more iterations on small Uint. On the code above, we
1609             --  only get 5 (on average) single precision iterations per large
1610             --  iteration. ???
1611
1612             Tmp_UI := (UI_From_Int (A) * U) + (UI_From_Int (B) * V);
1613             V := (UI_From_Int (C) * U) + (UI_From_Int (D) * V);
1614             U := Tmp_UI;
1615          end if;
1616
1617          --  If the operands are very different in magnitude, the loop will
1618          --  generate large amounts of short-lived data, which it is worth
1619          --  removing periodically.
1620
1621          if Iterations > 100 then
1622             Release_And_Save (Marks, U, V);
1623             Iterations := 0;
1624          end if;
1625       end loop;
1626    end UI_GCD;
1627
1628    ------------
1629    -- UI_Ge --
1630    ------------
1631
1632    function UI_Ge (Left : Int; Right : Uint) return Boolean is
1633    begin
1634       return not UI_Lt (UI_From_Int (Left), Right);
1635    end UI_Ge;
1636
1637    function UI_Ge (Left : Uint; Right : Int) return Boolean is
1638    begin
1639       return not UI_Lt (Left, UI_From_Int (Right));
1640    end UI_Ge;
1641
1642    function UI_Ge (Left : Uint; Right : Uint) return Boolean is
1643    begin
1644       return not UI_Lt (Left, Right);
1645    end UI_Ge;
1646
1647    ------------
1648    -- UI_Gt --
1649    ------------
1650
1651    function UI_Gt (Left : Int; Right : Uint) return Boolean is
1652    begin
1653       return UI_Lt (Right, UI_From_Int (Left));
1654    end UI_Gt;
1655
1656    function UI_Gt (Left : Uint; Right : Int) return Boolean is
1657    begin
1658       return UI_Lt (UI_From_Int (Right), Left);
1659    end UI_Gt;
1660
1661    function UI_Gt (Left : Uint; Right : Uint) return Boolean is
1662    begin
1663       return UI_Lt (Left => Right, Right => Left);
1664    end UI_Gt;
1665
1666    ---------------
1667    -- UI_Image --
1668    ---------------
1669
1670    procedure UI_Image (Input : Uint; Format : UI_Format := Auto) is
1671    begin
1672       Image_Out (Input, True, Format);
1673    end UI_Image;
1674
1675    -------------------------
1676    -- UI_Is_In_Int_Range --
1677    -------------------------
1678
1679    function UI_Is_In_Int_Range (Input : Uint) return Boolean is
1680    begin
1681       --  Make sure we don't get called before Initialize
1682
1683       pragma Assert (Uint_Int_First /= Uint_0);
1684
1685       if Direct (Input) then
1686          return True;
1687       else
1688          return Input >= Uint_Int_First
1689            and then Input <= Uint_Int_Last;
1690       end if;
1691    end UI_Is_In_Int_Range;
1692
1693    ------------
1694    -- UI_Le --
1695    ------------
1696
1697    function UI_Le (Left : Int; Right : Uint) return Boolean is
1698    begin
1699       return not UI_Lt (Right, UI_From_Int (Left));
1700    end UI_Le;
1701
1702    function UI_Le (Left : Uint; Right : Int) return Boolean is
1703    begin
1704       return not UI_Lt (UI_From_Int (Right), Left);
1705    end UI_Le;
1706
1707    function UI_Le (Left : Uint; Right : Uint) return Boolean is
1708    begin
1709       return not UI_Lt (Left => Right, Right => Left);
1710    end UI_Le;
1711
1712    ------------
1713    -- UI_Lt --
1714    ------------
1715
1716    function UI_Lt (Left : Int; Right : Uint) return Boolean is
1717    begin
1718       return UI_Lt (UI_From_Int (Left), Right);
1719    end UI_Lt;
1720
1721    function UI_Lt (Left : Uint; Right : Int) return Boolean is
1722    begin
1723       return UI_Lt (Left, UI_From_Int (Right));
1724    end UI_Lt;
1725
1726    function UI_Lt (Left : Uint; Right : Uint) return Boolean is
1727    begin
1728       --  Quick processing for identical arguments
1729
1730       if Int (Left) = Int (Right) then
1731          return False;
1732
1733       --  Quick processing for both arguments directly represented
1734
1735       elsif Direct (Left) and then Direct (Right) then
1736          return Int (Left) < Int (Right);
1737
1738       --  At least one argument is more than one digit long
1739
1740       else
1741          declare
1742             L_Length : constant Int := N_Digits (Left);
1743             R_Length : constant Int := N_Digits (Right);
1744
1745             L_Vec : UI_Vector (1 .. L_Length);
1746             R_Vec : UI_Vector (1 .. R_Length);
1747
1748          begin
1749             Init_Operand (Left, L_Vec);
1750             Init_Operand (Right, R_Vec);
1751
1752             if L_Vec (1) < Int_0 then
1753
1754                --  First argument negative, second argument non-negative
1755
1756                if R_Vec (1) >= Int_0 then
1757                   return True;
1758
1759                --  Both arguments negative
1760
1761                else
1762                   if L_Length /= R_Length then
1763                      return L_Length > R_Length;
1764
1765                   elsif L_Vec (1) /= R_Vec (1) then
1766                      return L_Vec (1) < R_Vec (1);
1767
1768                   else
1769                      for J in 2 .. L_Vec'Last loop
1770                         if L_Vec (J) /= R_Vec (J) then
1771                            return L_Vec (J) > R_Vec (J);
1772                         end if;
1773                      end loop;
1774
1775                      return False;
1776                   end if;
1777                end if;
1778
1779             else
1780                --  First argument non-negative, second argument negative
1781
1782                if R_Vec (1) < Int_0 then
1783                   return False;
1784
1785                --  Both arguments non-negative
1786
1787                else
1788                   if L_Length /= R_Length then
1789                      return L_Length < R_Length;
1790                   else
1791                      for J in L_Vec'Range loop
1792                         if L_Vec (J) /= R_Vec (J) then
1793                            return L_Vec (J) < R_Vec (J);
1794                         end if;
1795                      end loop;
1796
1797                      return False;
1798                   end if;
1799                end if;
1800             end if;
1801          end;
1802       end if;
1803    end UI_Lt;
1804
1805    ------------
1806    -- UI_Max --
1807    ------------
1808
1809    function UI_Max (Left : Int; Right : Uint) return Uint is
1810    begin
1811       return UI_Max (UI_From_Int (Left), Right);
1812    end UI_Max;
1813
1814    function UI_Max (Left : Uint; Right : Int) return Uint is
1815    begin
1816       return UI_Max (Left, UI_From_Int (Right));
1817    end UI_Max;
1818
1819    function UI_Max (Left : Uint; Right : Uint) return Uint is
1820    begin
1821       if Left >= Right then
1822          return Left;
1823       else
1824          return Right;
1825       end if;
1826    end UI_Max;
1827
1828    ------------
1829    -- UI_Min --
1830    ------------
1831
1832    function UI_Min (Left : Int; Right : Uint) return Uint is
1833    begin
1834       return UI_Min (UI_From_Int (Left), Right);
1835    end UI_Min;
1836
1837    function UI_Min (Left : Uint; Right : Int) return Uint is
1838    begin
1839       return UI_Min (Left, UI_From_Int (Right));
1840    end UI_Min;
1841
1842    function UI_Min (Left : Uint; Right : Uint) return Uint is
1843    begin
1844       if Left <= Right then
1845          return Left;
1846       else
1847          return Right;
1848       end if;
1849    end UI_Min;
1850
1851    -------------
1852    -- UI_Mod --
1853    -------------
1854
1855    function UI_Mod (Left : Int; Right : Uint) return Uint is
1856    begin
1857       return UI_Mod (UI_From_Int (Left), Right);
1858    end UI_Mod;
1859
1860    function UI_Mod (Left : Uint; Right : Int) return Uint is
1861    begin
1862       return UI_Mod (Left, UI_From_Int (Right));
1863    end UI_Mod;
1864
1865    function UI_Mod (Left : Uint; Right : Uint) return Uint is
1866       Urem : constant Uint := Left rem Right;
1867
1868    begin
1869       if (Left < Uint_0) = (Right < Uint_0)
1870         or else Urem = Uint_0
1871       then
1872          return Urem;
1873       else
1874          return Right + Urem;
1875       end if;
1876    end UI_Mod;
1877
1878    -------------------------------
1879    -- UI_Modular_Exponentiation --
1880    -------------------------------
1881
1882    function UI_Modular_Exponentiation
1883      (B      : Uint;
1884       E      : Uint;
1885       Modulo : Uint) return Uint
1886    is
1887       M : constant Save_Mark := Mark;
1888
1889       Result   : Uint := Uint_1;
1890       Base     : Uint := B;
1891       Exponent : Uint := E;
1892
1893    begin
1894       while Exponent /= Uint_0 loop
1895          if Least_Sig_Digit (Exponent) rem Int'(2) = Int'(1) then
1896             Result := (Result * Base) rem Modulo;
1897          end if;
1898
1899          Exponent := Exponent / Uint_2;
1900          Base := (Base * Base) rem Modulo;
1901       end loop;
1902
1903       Release_And_Save (M, Result);
1904       return Result;
1905    end UI_Modular_Exponentiation;
1906
1907    ------------------------
1908    -- UI_Modular_Inverse --
1909    ------------------------
1910
1911    function UI_Modular_Inverse (N : Uint; Modulo : Uint) return Uint is
1912       M : constant Save_Mark := Mark;
1913       U : Uint;
1914       V : Uint;
1915       Q : Uint;
1916       R : Uint;
1917       X : Uint;
1918       Y : Uint;
1919       T : Uint;
1920       S : Int := 1;
1921
1922    begin
1923       U := Modulo;
1924       V := N;
1925
1926       X := Uint_1;
1927       Y := Uint_0;
1928
1929       loop
1930          UI_Div_Rem (U, V, Quotient => Q, Remainder => R);
1931
1932          U := V;
1933          V := R;
1934
1935          T := X;
1936          X := Y + Q * X;
1937          Y := T;
1938          S := -S;
1939
1940          exit when R = Uint_1;
1941       end loop;
1942
1943       if S = Int'(-1) then
1944          X := Modulo - X;
1945       end if;
1946
1947       Release_And_Save (M, X);
1948       return X;
1949    end UI_Modular_Inverse;
1950
1951    ------------
1952    -- UI_Mul --
1953    ------------
1954
1955    function UI_Mul (Left : Int; Right : Uint) return Uint is
1956    begin
1957       return UI_Mul (UI_From_Int (Left), Right);
1958    end UI_Mul;
1959
1960    function UI_Mul (Left : Uint; Right : Int) return Uint is
1961    begin
1962       return UI_Mul (Left, UI_From_Int (Right));
1963    end UI_Mul;
1964
1965    function UI_Mul (Left : Uint; Right : Uint) return Uint is
1966    begin
1967       --  Case where product fits in the range of a 32-bit integer
1968
1969       if Int (Left)  <= Int (Uint_Max_Simple_Mul)
1970            and then
1971          Int (Right) <= Int (Uint_Max_Simple_Mul)
1972       then
1973          return UI_From_Int (Direct_Val (Left) * Direct_Val (Right));
1974       end if;
1975
1976       --  Otherwise we have the general case (Algorithm M in Knuth)
1977
1978       declare
1979          L_Length : constant Int := N_Digits (Left);
1980          R_Length : constant Int := N_Digits (Right);
1981          L_Vec    : UI_Vector (1 .. L_Length);
1982          R_Vec    : UI_Vector (1 .. R_Length);
1983          Neg      : Boolean;
1984
1985       begin
1986          Init_Operand (Left, L_Vec);
1987          Init_Operand (Right, R_Vec);
1988          Neg := (L_Vec (1) < Int_0) xor (R_Vec (1) < Int_0);
1989          L_Vec (1) := abs (L_Vec (1));
1990          R_Vec (1) := abs (R_Vec (1));
1991
1992          Algorithm_M : declare
1993             Product : UI_Vector (1 .. L_Length + R_Length);
1994             Tmp_Sum : Int;
1995             Carry   : Int;
1996
1997          begin
1998             for J in Product'Range loop
1999                Product (J) := 0;
2000             end loop;
2001
2002             for J in reverse R_Vec'Range loop
2003                Carry := 0;
2004                for K in reverse L_Vec'Range loop
2005                   Tmp_Sum :=
2006                     L_Vec (K) * R_Vec (J) + Product (J + K) + Carry;
2007                   Product (J + K) := Tmp_Sum rem Base;
2008                   Carry := Tmp_Sum / Base;
2009                end loop;
2010
2011                Product (J) := Carry;
2012             end loop;
2013
2014             return Vector_To_Uint (Product, Neg);
2015          end Algorithm_M;
2016       end;
2017    end UI_Mul;
2018
2019    ------------
2020    -- UI_Ne --
2021    ------------
2022
2023    function UI_Ne (Left : Int; Right : Uint) return Boolean is
2024    begin
2025       return UI_Ne (UI_From_Int (Left), Right);
2026    end UI_Ne;
2027
2028    function UI_Ne (Left : Uint; Right : Int) return Boolean is
2029    begin
2030       return UI_Ne (Left, UI_From_Int (Right));
2031    end UI_Ne;
2032
2033    function UI_Ne (Left : Uint; Right : Uint) return Boolean is
2034    begin
2035       --  Quick processing for identical arguments. Note that this takes
2036       --  care of the case of two No_Uint arguments.
2037
2038       if Int (Left) = Int (Right) then
2039          return False;
2040       end if;
2041
2042       --  See if left operand directly represented
2043
2044       if Direct (Left) then
2045
2046          --  If right operand directly represented then compare
2047
2048          if Direct (Right) then
2049             return Int (Left) /= Int (Right);
2050
2051          --  Left operand directly represented, right not, must be unequal
2052
2053          else
2054             return True;
2055          end if;
2056
2057       --  Right operand directly represented, left not, must be unequal
2058
2059       elsif Direct (Right) then
2060          return True;
2061       end if;
2062
2063       --  Otherwise both multi-word, do comparison
2064
2065       declare
2066          Size      : constant Int := N_Digits (Left);
2067          Left_Loc  : Int;
2068          Right_Loc : Int;
2069
2070       begin
2071          if Size /= N_Digits (Right) then
2072             return True;
2073          end if;
2074
2075          Left_Loc  := Uints.Table (Left).Loc;
2076          Right_Loc := Uints.Table (Right).Loc;
2077
2078          for J in Int_0 .. Size - Int_1 loop
2079             if Udigits.Table (Left_Loc + J) /=
2080                Udigits.Table (Right_Loc + J)
2081             then
2082                return True;
2083             end if;
2084          end loop;
2085
2086          return False;
2087       end;
2088    end UI_Ne;
2089
2090    ----------------
2091    -- UI_Negate --
2092    ----------------
2093
2094    function UI_Negate (Right : Uint) return Uint is
2095    begin
2096       --  Case where input is directly represented. Note that since the range
2097       --  of Direct values is non-symmetrical, the result may not be directly
2098       --  represented, this is taken care of in UI_From_Int.
2099
2100       if Direct (Right) then
2101          return UI_From_Int (-Direct_Val (Right));
2102
2103       --  Full processing for multi-digit case. Note that we cannot just copy
2104       --  the value to the end of the table negating the first digit, since the
2105       --  range of Direct values is non-symmetrical, so we can have a negative
2106       --  value that is not Direct whose negation can be represented directly.
2107
2108       else
2109          declare
2110             R_Length : constant Int := N_Digits (Right);
2111             R_Vec    : UI_Vector (1 .. R_Length);
2112             Neg      : Boolean;
2113
2114          begin
2115             Init_Operand (Right, R_Vec);
2116             Neg := R_Vec (1) > Int_0;
2117             R_Vec (1) := abs R_Vec (1);
2118             return Vector_To_Uint (R_Vec, Neg);
2119          end;
2120       end if;
2121    end UI_Negate;
2122
2123    -------------
2124    -- UI_Rem --
2125    -------------
2126
2127    function UI_Rem (Left : Int; Right : Uint) return Uint is
2128    begin
2129       return UI_Rem (UI_From_Int (Left), Right);
2130    end UI_Rem;
2131
2132    function UI_Rem (Left : Uint; Right : Int) return Uint is
2133    begin
2134       return UI_Rem (Left, UI_From_Int (Right));
2135    end UI_Rem;
2136
2137    function UI_Rem (Left, Right : Uint) return Uint is
2138       Remainder : Uint;
2139       Quotient  : Uint;
2140       pragma Warnings (Off, Quotient);
2141
2142    begin
2143       pragma Assert (Right /= Uint_0);
2144
2145       if Direct (Right) and then Direct (Left) then
2146          return UI_From_Int (Direct_Val (Left) rem Direct_Val (Right));
2147
2148       else
2149          UI_Div_Rem
2150            (Left, Right, Quotient, Remainder, Discard_Quotient => True);
2151          return Remainder;
2152       end if;
2153    end UI_Rem;
2154
2155    ------------
2156    -- UI_Sub --
2157    ------------
2158
2159    function UI_Sub (Left : Int; Right : Uint) return Uint is
2160    begin
2161       return UI_Add (Left, -Right);
2162    end UI_Sub;
2163
2164    function UI_Sub (Left : Uint; Right : Int) return Uint is
2165    begin
2166       return UI_Add (Left, -Right);
2167    end UI_Sub;
2168
2169    function UI_Sub (Left : Uint; Right : Uint) return Uint is
2170    begin
2171       if Direct (Left) and then Direct (Right) then
2172          return UI_From_Int (Direct_Val (Left) - Direct_Val (Right));
2173       else
2174          return UI_Add (Left, -Right);
2175       end if;
2176    end UI_Sub;
2177
2178    --------------
2179    -- UI_To_CC --
2180    --------------
2181
2182    function UI_To_CC (Input : Uint) return Char_Code is
2183    begin
2184       if Direct (Input) then
2185          return Char_Code (Direct_Val (Input));
2186
2187       --  Case of input is more than one digit
2188
2189       else
2190          declare
2191             In_Length : constant Int := N_Digits (Input);
2192             In_Vec    : UI_Vector (1 .. In_Length);
2193             Ret_CC    : Char_Code;
2194
2195          begin
2196             Init_Operand (Input, In_Vec);
2197
2198             --  We assume value is positive
2199
2200             Ret_CC := 0;
2201             for Idx in In_Vec'Range loop
2202                Ret_CC := Ret_CC * Char_Code (Base) +
2203                                   Char_Code (abs In_Vec (Idx));
2204             end loop;
2205
2206             return Ret_CC;
2207          end;
2208       end if;
2209    end UI_To_CC;
2210
2211    ----------------
2212    -- UI_To_Int --
2213    ----------------
2214
2215    function UI_To_Int (Input : Uint) return Int is
2216    begin
2217       if Direct (Input) then
2218          return Direct_Val (Input);
2219
2220       --  Case of input is more than one digit
2221
2222       else
2223          declare
2224             In_Length : constant Int := N_Digits (Input);
2225             In_Vec    : UI_Vector (1 .. In_Length);
2226             Ret_Int   : Int;
2227
2228          begin
2229             --  Uints of more than one digit could be outside the range for
2230             --  Ints. Caller should have checked for this if not certain.
2231             --  Fatal error to attempt to convert from value outside Int'Range.
2232
2233             pragma Assert (UI_Is_In_Int_Range (Input));
2234
2235             --  Otherwise, proceed ahead, we are OK
2236
2237             Init_Operand (Input, In_Vec);
2238             Ret_Int := 0;
2239
2240             --  Calculate -|Input| and then negates if value is positive. This
2241             --  handles our current definition of Int (based on 2s complement).
2242             --  Is it secure enough???
2243
2244             for Idx in In_Vec'Range loop
2245                Ret_Int := Ret_Int * Base - abs In_Vec (Idx);
2246             end loop;
2247
2248             if In_Vec (1) < Int_0 then
2249                return Ret_Int;
2250             else
2251                return -Ret_Int;
2252             end if;
2253          end;
2254       end if;
2255    end UI_To_Int;
2256
2257    --------------
2258    -- UI_Write --
2259    --------------
2260
2261    procedure UI_Write (Input : Uint; Format : UI_Format := Auto) is
2262    begin
2263       Image_Out (Input, False, Format);
2264    end UI_Write;
2265
2266    ---------------------
2267    -- Vector_To_Uint --
2268    ---------------------
2269
2270    function Vector_To_Uint
2271      (In_Vec   : UI_Vector;
2272       Negative : Boolean)
2273       return     Uint
2274    is
2275       Size : Int;
2276       Val  : Int;
2277
2278    begin
2279       --  The vector can contain leading zeros. These are not stored in the
2280       --  table, so loop through the vector looking for first non-zero digit
2281
2282       for J in In_Vec'Range loop
2283          if In_Vec (J) /= Int_0 then
2284
2285             --  The length of the value is the length of the rest of the vector
2286
2287             Size := In_Vec'Last - J + 1;
2288
2289             --  One digit value can always be represented directly
2290
2291             if Size = Int_1 then
2292                if Negative then
2293                   return Uint (Int (Uint_Direct_Bias) - In_Vec (J));
2294                else
2295                   return Uint (Int (Uint_Direct_Bias) + In_Vec (J));
2296                end if;
2297
2298             --  Positive two digit values may be in direct representation range
2299
2300             elsif Size = Int_2 and then not Negative then
2301                Val := In_Vec (J) * Base + In_Vec (J + 1);
2302
2303                if Val <= Max_Direct then
2304                   return Uint (Int (Uint_Direct_Bias) + Val);
2305                end if;
2306             end if;
2307
2308             --  The value is outside the direct representation range and must
2309             --  therefore be stored in the table. Expand the table to contain
2310             --  the count and digits. The index of the new table entry will be
2311             --  returned as the result.
2312
2313             Uints.Append ((Length => Size, Loc => Udigits.Last + 1));
2314
2315             if Negative then
2316                Val := -In_Vec (J);
2317             else
2318                Val := +In_Vec (J);
2319             end if;
2320
2321             Udigits.Append (Val);
2322
2323             for K in 2 .. Size loop
2324                Udigits.Append (In_Vec (J + K - 1));
2325             end loop;
2326
2327             return Uints.Last;
2328          end if;
2329       end loop;
2330
2331       --  Dropped through loop only if vector contained all zeros
2332
2333       return Uint_0;
2334    end Vector_To_Uint;
2335
2336 end Uintp;