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