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