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