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