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