gcc/ada/urealp.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               U R E A L P                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2017, 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 Alloc;
  33 with Output;  use Output;
  34 with Table;
  35 with Tree_IO; use Tree_IO;
  36
  37 package body Urealp is
  38
  39    Ureal_First_Entry : constant Ureal := Ureal'Succ (No_Ureal);
  40    --  First subscript allocated in Ureal table (note that we can't just
  41    --  add 1 to No_Ureal, since "+" means something different for Ureals).
  42
  43    type Ureal_Entry is record
  44       Num  : Uint;
  45       --  Numerator (always non-negative)
  46
  47       Den : Uint;
  48       --  Denominator (always non-zero, always positive if base is zero)
  49
  50       Rbase : Nat;
  51       --  Base value. If Rbase is zero, then the value is simply Num / Den.
  52       --  If Rbase is non-zero, then the value is Num / (Rbase ** Den)
  53
  54       Negative : Boolean;
  55       --  Flag set if value is negative
  56    end record;
  57
  58    --  The following representation clause ensures that the above record
  59    --  has no holes. We do this so that when instances of this record are
  60    --  written by Tree_Gen, we do not write uninitialized values to the file.
  61
  62    for Ureal_Entry use record
  63       Num      at  0 range 0 .. 31;
  64       Den      at  4 range 0 .. 31;
  65       Rbase    at  8 range 0 .. 31;
  66       Negative at 12 range 0 .. 31;
  67    end record;
  68
  69    for Ureal_Entry'Size use 16 * 8;
  70    --  This ensures that we did not leave out any fields
  71
  72    package Ureals is new Table.Table (
  73      Table_Component_Type => Ureal_Entry,
  74      Table_Index_Type     => Ureal'Base,
  75      Table_Low_Bound      => Ureal_First_Entry,
  76      Table_Initial        => Alloc.Ureals_Initial,
  77      Table_Increment      => Alloc.Ureals_Increment,
  78      Table_Name           => "Ureals");
  79
  80    --  The following universal reals are the values returned by the constant
  81    --  functions. They are initialized by the initialization procedure.
  82
  83    UR_0       : Ureal;
  84    UR_M_0     : Ureal;
  85    UR_Tenth   : Ureal;
  86    UR_Half    : Ureal;
  87    UR_1       : Ureal;
  88    UR_2       : Ureal;
  89    UR_10      : Ureal;
  90    UR_10_36   : Ureal;
  91    UR_M_10_36 : Ureal;
  92    UR_100     : Ureal;
  93    UR_2_128   : Ureal;
  94    UR_2_80    : Ureal;
  95    UR_2_M_128 : Ureal;
  96    UR_2_M_80  : Ureal;
  97
  98    Num_Ureal_Constants : constant := 10;
  99    --  This is used for an assertion check in Tree_Read and Tree_Write to
 100    --  help remember to add values to these routines when we add to the list.
 101
 102    Normalized_Real : Ureal := No_Ureal;
 103    --  Used to memoize Norm_Num and Norm_Den, if either of these functions
 104    --  is called, this value is set and Normalized_Entry contains the result
 105    --  of the normalization. On subsequent calls, this is used to avoid the
 106    --  call to Normalize if it has already been made.
 107
 108    Normalized_Entry : Ureal_Entry;
 109    --  Entry built by most recent call to Normalize
 110
 111    -----------------------
 112    -- Local Subprograms --
 113    -----------------------
 114
 115    function Decimal_Exponent_Hi (V : Ureal) return Int;
 116    --  Returns an estimate of the exponent of Val represented as a normalized
 117    --  decimal number (non-zero digit before decimal point), The estimate is
 118    --  either correct, or high, but never low. The accuracy of the estimate
 119    --  affects only the efficiency of the comparison routines.
 120
 121    function Decimal_Exponent_Lo (V : Ureal) return Int;
 122    --  Returns an estimate of the exponent of Val represented as a normalized
 123    --  decimal number (non-zero digit before decimal point), The estimate is
 124    --  either correct, or low, but never high. The accuracy of the estimate
 125    --  affects only the efficiency of the comparison routines.
 126
 127    function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int;
 128    --  U is a Ureal entry for which the base value is non-zero, the value
 129    --  returned is the equivalent decimal exponent value, i.e. the value of
 130    --  Den, adjusted as though the base were base 10. The value is rounded
 131    --  toward zero (truncated), and so its value can be off by one.
 132
 133    function Is_Integer (Num, Den : Uint) return Boolean;
 134    --  Return true if the real quotient of Num / Den is an integer value
 135
 136    function Normalize (Val : Ureal_Entry) return Ureal_Entry;
 137    --  Normalizes the Ureal_Entry by reducing it to lowest terms (with a base
 138    --  value of 0).
 139
 140    function Same (U1, U2 : Ureal) return Boolean;
 141    pragma Inline (Same);
 142    --  Determines if U1 and U2 are the same Ureal. Note that we cannot use
 143    --  the equals operator for this test, since that tests for equality, not
 144    --  identity.
 145
 146    function Store_Ureal (Val : Ureal_Entry) return Ureal;
 147    --  This store a new entry in the universal reals table and return its index
 148    --  in the table.
 149
 150    function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal;
 151    pragma Inline (Store_Ureal_Normalized);
 152    --  Like Store_Ureal, but normalizes its operand first
 153
 154    -------------------------
 155    -- Decimal_Exponent_Hi --
 156    -------------------------
 157
 158    function Decimal_Exponent_Hi (V : Ureal) return Int is
 159       Val : constant Ureal_Entry := Ureals.Table (V);
 160
 161    begin
 162       --  Zero always returns zero
 163
 164       if UR_Is_Zero (V) then
 165          return 0;
 166
 167       --  For numbers in rational form, get the maximum number of digits in the
 168       --  numerator and the minimum number of digits in the denominator, and
 169       --  subtract. For example:
 170
 171       --     1000 / 99 = 1.010E+1
 172       --     9999 / 10 = 9.999E+2
 173
 174       --  This estimate may of course be high, but that is acceptable
 175
 176       elsif Val.Rbase = 0 then
 177          return UI_Decimal_Digits_Hi (Val.Num) -
 178                 UI_Decimal_Digits_Lo (Val.Den);
 179
 180       --  For based numbers, just subtract the decimal exponent from the
 181       --  high estimate of the number of digits in the numerator and add
 182       --  one to accommodate possible round off errors for non-decimal
 183       --  bases. For example:
 184
 185       --     1_500_000 / 10**4 = 1.50E-2
 186
 187       else -- Val.Rbase /= 0
 188          return UI_Decimal_Digits_Hi (Val.Num) -
 189                 Equivalent_Decimal_Exponent (Val) + 1;
 190       end if;
 191    end Decimal_Exponent_Hi;
 192
 193    -------------------------
 194    -- Decimal_Exponent_Lo --
 195    -------------------------
 196
 197    function Decimal_Exponent_Lo (V : Ureal) return Int is
 198       Val : constant Ureal_Entry := Ureals.Table (V);
 199
 200    begin
 201       --  Zero always returns zero
 202
 203       if UR_Is_Zero (V) then
 204          return 0;
 205
 206       --  For numbers in rational form, get min digits in numerator, max digits
 207       --  in denominator, and subtract and subtract one more for possible loss
 208       --  during the division. For example:
 209
 210       --     1000 / 99 = 1.010E+1
 211       --     9999 / 10 = 9.999E+2
 212
 213       --  This estimate may of course be low, but that is acceptable
 214
 215       elsif Val.Rbase = 0 then
 216          return UI_Decimal_Digits_Lo (Val.Num) -
 217                 UI_Decimal_Digits_Hi (Val.Den) - 1;
 218
 219       --  For based numbers, just subtract the decimal exponent from the
 220       --  low estimate of the number of digits in the numerator and subtract
 221       --  one to accommodate possible round off errors for non-decimal
 222       --  bases. For example:
 223
 224       --     1_500_000 / 10**4 = 1.50E-2
 225
 226       else -- Val.Rbase /= 0
 227          return UI_Decimal_Digits_Lo (Val.Num) -
 228                 Equivalent_Decimal_Exponent (Val) - 1;
 229       end if;
 230    end Decimal_Exponent_Lo;
 231
 232    -----------------
 233    -- Denominator --
 234    -----------------
 235
 236    function Denominator (Real : Ureal) return Uint is
 237    begin
 238       return Ureals.Table (Real).Den;
 239    end Denominator;
 240
 241    ---------------------------------
 242    -- Equivalent_Decimal_Exponent --
 243    ---------------------------------
 244
 245    function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is
 246
 247       type Ratio is record
 248          Num : Nat;
 249          Den : Nat;
 250       end record;
 251
 252       --  The following table is a table of logs to the base 10. All values
 253       --  have at least 15 digits of precision, and do not exceed the true
 254       --  value. To avoid the use of floating point, and as a result potential
 255       --  target dependency, each entry is represented as a fraction of two
 256       --  integers.
 257
 258       Logs : constant array (Nat range 1 .. 16) of Ratio :=
 259         (1 => (Num =>           0, Den =>            1),  -- 0
 260          2 => (Num =>  15_392_313, Den =>   51_132_157),  -- 0.301029995663981
 261          3 => (Num => 731_111_920, Den => 1532_339_867),  -- 0.477121254719662
 262          4 => (Num =>  30_784_626, Den =>   51_132_157),  -- 0.602059991327962
 263          5 => (Num => 111_488_153, Den =>  159_503_487),  -- 0.698970004336018
 264          6 => (Num =>  84_253_929, Den =>  108_274_489),  -- 0.778151250383643
 265          7 => (Num =>  35_275_468, Den =>   41_741_273),  -- 0.845098040014256
 266          8 => (Num =>  46_176_939, Den =>   51_132_157),  -- 0.903089986991943
 267          9 => (Num => 417_620_173, Den =>  437_645_744),  -- 0.954242509439324
 268         10 => (Num =>           1, Den =>            1),  -- 1.000000000000000
 269         11 => (Num => 136_507_510, Den =>  131_081_687),  -- 1.041392685158225
 270         12 => (Num =>  26_797_783, Den =>   24_831_587),  -- 1.079181246047624
 271         13 => (Num =>  73_333_297, Den =>   65_832_160),  -- 1.113943352306836
 272         14 => (Num => 102_941_258, Den =>   89_816_543),  -- 1.146128035678238
 273         15 => (Num =>  53_385_559, Den =>   45_392_361),  -- 1.176091259055681
 274         16 => (Num =>  78_897_839, Den =>   65_523_237)); -- 1.204119982655924
 275
 276       function Scale (X : Int; R : Ratio) return Int;
 277       --  Compute the value of X scaled by R
 278
 279       -----------
 280       -- Scale --
 281       -----------
 282
 283       function Scale (X : Int; R : Ratio) return Int is
 284          type Wide_Int is range -2**63 .. 2**63 - 1;
 285
 286       begin
 287          return Int (Wide_Int (X) * Wide_Int (R.Num) / Wide_Int (R.Den));
 288       end Scale;
 289
 290    begin
 291       pragma Assert (U.Rbase /= 0);
 292       return Scale (UI_To_Int (U.Den), Logs (U.Rbase));
 293    end Equivalent_Decimal_Exponent;
 294
 295    ----------------
 296    -- Initialize --
 297    ----------------
 298
 299    procedure Initialize is
 300    begin
 301       Ureals.Init;
 302       UR_0       := UR_From_Components (Uint_0, Uint_1,         0, False);
 303       UR_M_0     := UR_From_Components (Uint_0, Uint_1,         0, True);
 304       UR_Half    := UR_From_Components (Uint_1, Uint_1,         2, False);
 305       UR_Tenth   := UR_From_Components (Uint_1, Uint_1,        10, False);
 306       UR_1       := UR_From_Components (Uint_1, Uint_1,         0, False);
 307       UR_2       := UR_From_Components (Uint_1, Uint_Minus_1,   2, False);
 308       UR_10      := UR_From_Components (Uint_1, Uint_Minus_1,  10, False);
 309       UR_10_36   := UR_From_Components (Uint_1, Uint_Minus_36, 10, False);
 310       UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True);
 311       UR_100     := UR_From_Components (Uint_1, Uint_Minus_2,  10, False);
 312       UR_2_128   := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);
 313       UR_2_M_128 := UR_From_Components (Uint_1, Uint_128,       2, False);
 314       UR_2_80    := UR_From_Components (Uint_1, Uint_Minus_80,  2, False);
 315       UR_2_M_80  := UR_From_Components (Uint_1, Uint_80,        2, False);
 316    end Initialize;
 317
 318    ----------------
 319    -- Is_Integer --
 320    ----------------
 321
 322    function Is_Integer (Num, Den : Uint) return Boolean is
 323    begin
 324       return (Num / Den) * Den = Num;
 325    end Is_Integer;
 326
 327    ----------
 328    -- Mark --
 329    ----------
 330
 331    function Mark return Save_Mark is
 332    begin
 333       return Save_Mark (Ureals.Last);
 334    end Mark;
 335
 336    --------------
 337    -- Norm_Den --
 338    --------------
 339
 340    function Norm_Den (Real : Ureal) return Uint is
 341    begin
 342       if not Same (Real, Normalized_Real) then
 343          Normalized_Real  := Real;
 344          Normalized_Entry := Normalize (Ureals.Table (Real));
 345       end if;
 346
 347       return Normalized_Entry.Den;
 348    end Norm_Den;
 349
 350    --------------
 351    -- Norm_Num --
 352    --------------
 353
 354    function Norm_Num (Real : Ureal) return Uint is
 355    begin
 356       if not Same (Real, Normalized_Real) then
 357          Normalized_Real  := Real;
 358          Normalized_Entry := Normalize (Ureals.Table (Real));
 359       end if;
 360
 361       return Normalized_Entry.Num;
 362    end Norm_Num;
 363
 364    ---------------
 365    -- Normalize --
 366    ---------------
 367
 368    function Normalize (Val : Ureal_Entry) return Ureal_Entry is
 369       J   : Uint;
 370       K   : Uint;
 371       Tmp : Uint;
 372       Num : Uint;
 373       Den : Uint;
 374       M   : constant Uintp.Save_Mark := Uintp.Mark;
 375
 376    begin
 377       --  Start by setting J to the greatest of the absolute values of the
 378       --  numerator and the denominator (taking into account the base value),
 379       --  and K to the lesser of the two absolute values. The gcd of Num and
 380       --  Den is the gcd of J and K.
 381
 382       if Val.Rbase = 0 then
 383          J := Val.Num;
 384          K := Val.Den;
 385
 386       elsif Val.Den < 0 then
 387          J := Val.Num * Val.Rbase ** (-Val.Den);
 388          K := Uint_1;
 389
 390       else
 391          J := Val.Num;
 392          K := Val.Rbase ** Val.Den;
 393       end if;
 394
 395       Num := J;
 396       Den := K;
 397
 398       if K > J then
 399          Tmp := J;
 400          J := K;
 401          K := Tmp;
 402       end if;
 403
 404       J := UI_GCD (J, K);
 405       Num := Num / J;
 406       Den := Den / J;
 407       Uintp.Release_And_Save (M, Num, Den);
 408
 409       --  Divide numerator and denominator by gcd and return result
 410
 411       return (Num      => Num,
 412               Den      => Den,
 413               Rbase    => 0,
 414               Negative => Val.Negative);
 415    end Normalize;
 416
 417    ---------------
 418    -- Numerator --
 419    ---------------
 420
 421    function Numerator (Real : Ureal) return Uint is
 422    begin
 423       return Ureals.Table (Real).Num;
 424    end Numerator;
 425
 426    --------
 427    -- pr --
 428    --------
 429
 430    procedure pr (Real : Ureal) is
 431    begin
 432       UR_Write (Real);
 433       Write_Eol;
 434    end pr;
 435
 436    -----------
 437    -- Rbase --
 438    -----------
 439
 440    function Rbase (Real : Ureal) return Nat is
 441    begin
 442       return Ureals.Table (Real).Rbase;
 443    end Rbase;
 444
 445    -------------
 446    -- Release --
 447    -------------
 448
 449    procedure Release (M : Save_Mark) is
 450    begin
 451       Ureals.Set_Last (Ureal (M));
 452    end Release;
 453
 454    ----------
 455    -- Same --
 456    ----------
 457
 458    function Same (U1, U2 : Ureal) return Boolean is
 459    begin
 460       return Int (U1) = Int (U2);
 461    end Same;
 462
 463    -----------------
 464    -- Store_Ureal --
 465    -----------------
 466
 467    function Store_Ureal (Val : Ureal_Entry) return Ureal is
 468    begin
 469       Ureals.Append (Val);
 470
 471       --  Normalize representation of signed values
 472
 473       if Val.Num < 0 then
 474          Ureals.Table (Ureals.Last).Negative := True;
 475          Ureals.Table (Ureals.Last).Num := -Val.Num;
 476       end if;
 477
 478       return Ureals.Last;
 479    end Store_Ureal;
 480
 481    ----------------------------
 482    -- Store_Ureal_Normalized --
 483    ----------------------------
 484
 485    function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is
 486    begin
 487       return Store_Ureal (Normalize (Val));
 488    end Store_Ureal_Normalized;
 489
 490    ---------------
 491    -- Tree_Read --
 492    ---------------
 493
 494    procedure Tree_Read is
 495    begin
 496       pragma Assert (Num_Ureal_Constants = 10);
 497
 498       Ureals.Tree_Read;
 499       Tree_Read_Int (Int (UR_0));
 500       Tree_Read_Int (Int (UR_M_0));
 501       Tree_Read_Int (Int (UR_Tenth));
 502       Tree_Read_Int (Int (UR_Half));
 503       Tree_Read_Int (Int (UR_1));
 504       Tree_Read_Int (Int (UR_2));
 505       Tree_Read_Int (Int (UR_10));
 506       Tree_Read_Int (Int (UR_100));
 507       Tree_Read_Int (Int (UR_2_128));
 508       Tree_Read_Int (Int (UR_2_M_128));
 509
 510       --  Clear the normalization cache
 511
 512       Normalized_Real := No_Ureal;
 513    end Tree_Read;
 514
 515    ----------------
 516    -- Tree_Write --
 517    ----------------
 518
 519    procedure Tree_Write is
 520    begin
 521       pragma Assert (Num_Ureal_Constants = 10);
 522
 523       Ureals.Tree_Write;
 524       Tree_Write_Int (Int (UR_0));
 525       Tree_Write_Int (Int (UR_M_0));
 526       Tree_Write_Int (Int (UR_Tenth));
 527       Tree_Write_Int (Int (UR_Half));
 528       Tree_Write_Int (Int (UR_1));
 529       Tree_Write_Int (Int (UR_2));
 530       Tree_Write_Int (Int (UR_10));
 531       Tree_Write_Int (Int (UR_100));
 532       Tree_Write_Int (Int (UR_2_128));
 533       Tree_Write_Int (Int (UR_2_M_128));
 534    end Tree_Write;
 535
 536    ------------
 537    -- UR_Abs --
 538    ------------
 539
 540    function UR_Abs (Real : Ureal) return Ureal is
 541       Val : constant Ureal_Entry := Ureals.Table (Real);
 542
 543    begin
 544       return Store_Ureal
 545                ((Num      => Val.Num,
 546                  Den      => Val.Den,
 547                  Rbase    => Val.Rbase,
 548                  Negative => False));
 549    end UR_Abs;
 550
 551    ------------
 552    -- UR_Add --
 553    ------------
 554
 555    function UR_Add (Left : Uint; Right : Ureal) return Ureal is
 556    begin
 557       return UR_From_Uint (Left) + Right;
 558    end UR_Add;
 559
 560    function UR_Add (Left : Ureal; Right : Uint) return Ureal is
 561    begin
 562       return Left + UR_From_Uint (Right);
 563    end UR_Add;
 564
 565    function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
 566       Lval : Ureal_Entry := Ureals.Table (Left);
 567       Rval : Ureal_Entry := Ureals.Table (Right);
 568       Num  : Uint;
 569
 570    begin
 571       --  Note, in the temporary Ureal_Entry values used in this procedure,
 572       --  we store the sign as the sign of the numerator (i.e. xxx.Num may
 573       --  be negative, even though in stored entries this can never be so)
 574
 575       if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
 576          declare
 577             Opd_Min, Opd_Max   : Ureal_Entry;
 578             Exp_Min, Exp_Max   : Uint;
 579
 580          begin
 581             if Lval.Negative then
 582                Lval.Num := (-Lval.Num);
 583             end if;
 584
 585             if Rval.Negative then
 586                Rval.Num := (-Rval.Num);
 587             end if;
 588
 589             if Lval.Den < Rval.Den then
 590                Exp_Min := Lval.Den;
 591                Exp_Max := Rval.Den;
 592                Opd_Min := Lval;
 593                Opd_Max := Rval;
 594             else
 595                Exp_Min := Rval.Den;
 596                Exp_Max := Lval.Den;
 597                Opd_Min := Rval;
 598                Opd_Max := Lval;
 599             end if;
 600
 601             Num :=
 602               Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
 603
 604             if Num = 0 then
 605                return Store_Ureal
 606                         ((Num      => Uint_0,
 607                           Den      => Uint_1,
 608                           Rbase    => 0,
 609                           Negative => Lval.Negative));
 610
 611             else
 612                return Store_Ureal
 613                         ((Num      => abs Num,
 614                           Den      => Exp_Max,
 615                           Rbase    => Lval.Rbase,
 616                           Negative => (Num < 0)));
 617             end if;
 618          end;
 619
 620       else
 621          declare
 622             Ln : Ureal_Entry := Normalize (Lval);
 623             Rn : Ureal_Entry := Normalize (Rval);
 624
 625          begin
 626             if Ln.Negative then
 627                Ln.Num := (-Ln.Num);
 628             end if;
 629
 630             if Rn.Negative then
 631                Rn.Num := (-Rn.Num);
 632             end if;
 633
 634             Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
 635
 636             if Num = 0 then
 637                return Store_Ureal
 638                         ((Num      => Uint_0,
 639                           Den      => Uint_1,
 640                           Rbase    => 0,
 641                           Negative => Lval.Negative));
 642
 643             else
 644                return Store_Ureal_Normalized
 645                         ((Num      => abs Num,
 646                           Den      => Ln.Den * Rn.Den,
 647                           Rbase    => 0,
 648                           Negative => (Num < 0)));
 649             end if;
 650          end;
 651       end if;
 652    end UR_Add;
 653
 654    ----------------
 655    -- UR_Ceiling --
 656    ----------------
 657
 658    function UR_Ceiling (Real : Ureal) return Uint is
 659       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
 660    begin
 661       if Val.Negative then
 662          return UI_Negate (Val.Num / Val.Den);
 663       else
 664          return (Val.Num + Val.Den - 1) / Val.Den;
 665       end if;
 666    end UR_Ceiling;
 667
 668    ------------
 669    -- UR_Div --
 670    ------------
 671
 672    function UR_Div (Left : Uint; Right : Ureal) return Ureal is
 673    begin
 674       return UR_From_Uint (Left) / Right;
 675    end UR_Div;
 676
 677    function UR_Div (Left : Ureal; Right : Uint) return Ureal is
 678    begin
 679       return Left / UR_From_Uint (Right);
 680    end UR_Div;
 681
 682    function UR_Div (Left, Right : Ureal) return Ureal is
 683       Lval : constant Ureal_Entry := Ureals.Table (Left);
 684       Rval : constant Ureal_Entry := Ureals.Table (Right);
 685       Rneg : constant Boolean     := Rval.Negative xor Lval.Negative;
 686
 687    begin
 688       pragma Assert (Rval.Num /= Uint_0);
 689
 690       if Lval.Rbase = 0 then
 691          if Rval.Rbase = 0 then
 692             return Store_Ureal_Normalized
 693                      ((Num      => Lval.Num * Rval.Den,
 694                        Den      => Lval.Den * Rval.Num,
 695                        Rbase    => 0,
 696                        Negative => Rneg));
 697
 698          elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
 699             return Store_Ureal
 700                      ((Num      => Lval.Num / (Rval.Num * Lval.Den),
 701                        Den      => (-Rval.Den),
 702                        Rbase    => Rval.Rbase,
 703                        Negative => Rneg));
 704
 705          elsif Rval.Den < 0 then
 706             return Store_Ureal_Normalized
 707                      ((Num      => Lval.Num,
 708                        Den      => Rval.Rbase ** (-Rval.Den) *
 709                                    Rval.Num *
 710                                    Lval.Den,
 711                        Rbase    => 0,
 712                        Negative => Rneg));
 713
 714          else
 715             return Store_Ureal_Normalized
 716                      ((Num      => Lval.Num * Rval.Rbase ** Rval.Den,
 717                        Den      => Rval.Num * Lval.Den,
 718                        Rbase    => 0,
 719                        Negative => Rneg));
 720          end if;
 721
 722       elsif Is_Integer (Lval.Num, Rval.Num) then
 723          if Rval.Rbase = Lval.Rbase then
 724             return Store_Ureal
 725                      ((Num      => Lval.Num / Rval.Num,
 726                        Den      => Lval.Den - Rval.Den,
 727                        Rbase    => Lval.Rbase,
 728                        Negative => Rneg));
 729
 730          elsif Rval.Rbase = 0 then
 731             return Store_Ureal
 732                      ((Num      => (Lval.Num / Rval.Num) * Rval.Den,
 733                        Den      => Lval.Den,
 734                        Rbase    => Lval.Rbase,
 735                        Negative => Rneg));
 736
 737          elsif Rval.Den < 0 then
 738             declare
 739                Num, Den : Uint;
 740
 741             begin
 742                if Lval.Den < 0 then
 743                   Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
 744                   Den := Rval.Rbase ** (-Rval.Den);
 745                else
 746                   Num := Lval.Num / Rval.Num;
 747                   Den := (Lval.Rbase ** Lval.Den) *
 748                          (Rval.Rbase ** (-Rval.Den));
 749                end if;
 750
 751                return Store_Ureal
 752                         ((Num      => Num,
 753                           Den      => Den,
 754                           Rbase    => 0,
 755                           Negative => Rneg));
 756             end;
 757
 758          else
 759             return Store_Ureal
 760                      ((Num      => (Lval.Num / Rval.Num) *
 761                                    (Rval.Rbase ** Rval.Den),
 762                        Den      => Lval.Den,
 763                        Rbase    => Lval.Rbase,
 764                        Negative => Rneg));
 765          end if;
 766
 767       else
 768          declare
 769             Num, Den : Uint;
 770
 771          begin
 772             if Lval.Den < 0 then
 773                Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
 774                Den := Rval.Num;
 775             else
 776                Num := Lval.Num;
 777                Den := Rval.Num * (Lval.Rbase ** Lval.Den);
 778             end if;
 779
 780             if Rval.Rbase /= 0 then
 781                if Rval.Den < 0 then
 782                   Den := Den * (Rval.Rbase ** (-Rval.Den));
 783                else
 784                   Num := Num * (Rval.Rbase ** Rval.Den);
 785                end if;
 786
 787             else
 788                Num := Num * Rval.Den;
 789             end if;
 790
 791             return Store_Ureal_Normalized
 792                      ((Num      => Num,
 793                        Den      => Den,
 794                        Rbase    => 0,
 795                        Negative => Rneg));
 796          end;
 797       end if;
 798    end UR_Div;
 799
 800    -----------
 801    -- UR_Eq --
 802    -----------
 803
 804    function UR_Eq (Left, Right : Ureal) return Boolean is
 805    begin
 806       return not UR_Ne (Left, Right);
 807    end UR_Eq;
 808
 809    ---------------------
 810    -- UR_Exponentiate --
 811    ---------------------
 812
 813    function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
 814       X    : constant Uint := abs N;
 815       Bas  : Ureal;
 816       Val  : Ureal_Entry;
 817       Neg  : Boolean;
 818       IBas : Uint;
 819
 820    begin
 821       --  If base is negative, then the resulting sign depends on whether
 822       --  the exponent is even or odd (even => positive, odd = negative)
 823
 824       if UR_Is_Negative (Real) then
 825          Neg := (N mod 2) /= 0;
 826          Bas := UR_Negate (Real);
 827       else
 828          Neg := False;
 829          Bas := Real;
 830       end if;
 831
 832       Val := Ureals.Table (Bas);
 833
 834       --  If the base is a small integer, then we can return the result in
 835       --  exponential form, which can save a lot of time for junk exponents.
 836
 837       IBas := UR_Trunc (Bas);
 838
 839       if IBas <= 16
 840         and then UR_From_Uint (IBas) = Bas
 841       then
 842          return Store_Ureal
 843                   ((Num      => Uint_1,
 844                     Den      => -N,
 845                     Rbase    => UI_To_Int (UR_Trunc (Bas)),
 846                     Negative => Neg));
 847
 848       --  If the exponent is negative then we raise the numerator and the
 849       --  denominator (after normalization) to the absolute value of the
 850       --  exponent and we return the reciprocal. An assert error will happen
 851       --  if the numerator is zero.
 852
 853       elsif N < 0 then
 854          pragma Assert (Val.Num /= 0);
 855          Val := Normalize (Val);
 856
 857          return Store_Ureal
 858                   ((Num      => Val.Den ** X,
 859                     Den      => Val.Num ** X,
 860                     Rbase    => 0,
 861                     Negative => Neg));
 862
 863       --  If positive, we distinguish the case when the base is not zero, in
 864       --  which case the new denominator is just the product of the old one
 865       --  with the exponent,
 866
 867       else
 868          if Val.Rbase /= 0 then
 869
 870             return Store_Ureal
 871                      ((Num      => Val.Num ** X,
 872                        Den      => Val.Den * X,
 873                        Rbase    => Val.Rbase,
 874                        Negative => Neg));
 875
 876          --  And when the base is zero, in which case we exponentiate
 877          --  the old denominator.
 878
 879          else
 880             return Store_Ureal
 881                      ((Num      => Val.Num ** X,
 882                        Den      => Val.Den ** X,
 883                        Rbase    => 0,
 884                        Negative => Neg));
 885          end if;
 886       end if;
 887    end UR_Exponentiate;
 888
 889    --------------
 890    -- UR_Floor --
 891    --------------
 892
 893    function UR_Floor (Real : Ureal) return Uint is
 894       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
 895    begin
 896       if Val.Negative then
 897          return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
 898       else
 899          return Val.Num / Val.Den;
 900       end if;
 901    end UR_Floor;
 902
 903    ------------------------
 904    -- UR_From_Components --
 905    ------------------------
 906
 907    function UR_From_Components
 908      (Num      : Uint;
 909       Den      : Uint;
 910       Rbase    : Nat := 0;
 911       Negative : Boolean := False)
 912       return     Ureal
 913    is
 914    begin
 915       return Store_Ureal
 916                ((Num      => Num,
 917                  Den      => Den,
 918                  Rbase    => Rbase,
 919                  Negative => Negative));
 920    end UR_From_Components;
 921
 922    ------------------
 923    -- UR_From_Uint --
 924    ------------------
 925
 926    function UR_From_Uint (UI : Uint) return Ureal is
 927    begin
 928       return UR_From_Components
 929                (abs UI, Uint_1, Negative => (UI < 0));
 930    end UR_From_Uint;
 931
 932    -----------
 933    -- UR_Ge --
 934    -----------
 935
 936    function UR_Ge (Left, Right : Ureal) return Boolean is
 937    begin
 938       return not (Left < Right);
 939    end UR_Ge;
 940
 941    -----------
 942    -- UR_Gt --
 943    -----------
 944
 945    function UR_Gt (Left, Right : Ureal) return Boolean is
 946    begin
 947       return (Right < Left);
 948    end UR_Gt;
 949
 950    --------------------
 951    -- UR_Is_Negative --
 952    --------------------
 953
 954    function UR_Is_Negative (Real : Ureal) return Boolean is
 955    begin
 956       return Ureals.Table (Real).Negative;
 957    end UR_Is_Negative;
 958
 959    --------------------
 960    -- UR_Is_Positive --
 961    --------------------
 962
 963    function UR_Is_Positive (Real : Ureal) return Boolean is
 964    begin
 965       return not Ureals.Table (Real).Negative
 966         and then Ureals.Table (Real).Num /= 0;
 967    end UR_Is_Positive;
 968
 969    ----------------
 970    -- UR_Is_Zero --
 971    ----------------
 972
 973    function UR_Is_Zero (Real : Ureal) return Boolean is
 974    begin
 975       return Ureals.Table (Real).Num = 0;
 976    end UR_Is_Zero;
 977
 978    -----------
 979    -- UR_Le --
 980    -----------
 981
 982    function UR_Le (Left, Right : Ureal) return Boolean is
 983    begin
 984       return not (Right < Left);
 985    end UR_Le;
 986
 987    -----------
 988    -- UR_Lt --
 989    -----------
 990
 991    function UR_Lt (Left, Right : Ureal) return Boolean is
 992    begin
 993       --  An operand is not less than itself
 994
 995       if Same (Left, Right) then
 996          return False;
 997
 998       --  Deal with zero cases
 999
1000       elsif UR_Is_Zero (Left) then
1001          return UR_Is_Positive (Right);
1002
1003       elsif UR_Is_Zero (Right) then
1004          return Ureals.Table (Left).Negative;
1005
1006       --  Different signs are decisive (note we dealt with zero cases)
1007
1008       elsif Ureals.Table (Left).Negative
1009         and then not Ureals.Table (Right).Negative
1010       then
1011          return True;
1012
1013       elsif not Ureals.Table (Left).Negative
1014         and then Ureals.Table (Right).Negative
1015       then
1016          return False;
1017
1018       --  Signs are same, do rapid check based on worst case estimates of
1019       --  decimal exponent, which will often be decisive. Precise test
1020       --  depends on whether operands are positive or negative.
1021
1022       elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
1023          return UR_Is_Positive (Left);
1024
1025       elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
1026          return UR_Is_Negative (Left);
1027
1028       --  If we fall through, full gruesome test is required. This happens
1029       --  if the numbers are close together, or in some weird (/=10) base.
1030
1031       else
1032          declare
1033             Imrk   : constant Uintp.Save_Mark  := Mark;
1034             Rmrk   : constant Urealp.Save_Mark := Mark;
1035             Lval   : Ureal_Entry;
1036             Rval   : Ureal_Entry;
1037             Result : Boolean;
1038
1039          begin
1040             Lval := Ureals.Table (Left);
1041             Rval := Ureals.Table (Right);
1042
1043             --  An optimization. If both numbers are based, then subtract
1044             --  common value of base to avoid unnecessarily giant numbers
1045
1046             if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
1047                if Lval.Den < Rval.Den then
1048                   Rval.Den := Rval.Den - Lval.Den;
1049                   Lval.Den := Uint_0;
1050                else
1051                   Lval.Den := Lval.Den - Rval.Den;
1052                   Rval.Den := Uint_0;
1053                end if;
1054             end if;
1055
1056             Lval := Normalize (Lval);
1057             Rval := Normalize (Rval);
1058
1059             if Lval.Negative then
1060                Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
1061             else
1062                Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
1063             end if;
1064
1065             Release (Imrk);
1066             Release (Rmrk);
1067             return Result;
1068          end;
1069       end if;
1070    end UR_Lt;
1071
1072    ------------
1073    -- UR_Max --
1074    ------------
1075
1076    function UR_Max (Left, Right : Ureal) return Ureal is
1077    begin
1078       if Left >= Right then
1079          return Left;
1080       else
1081          return Right;
1082       end if;
1083    end UR_Max;
1084
1085    ------------
1086    -- UR_Min --
1087    ------------
1088
1089    function UR_Min (Left, Right : Ureal) return Ureal is
1090    begin
1091       if Left <= Right then
1092          return Left;
1093       else
1094          return Right;
1095       end if;
1096    end UR_Min;
1097
1098    ------------
1099    -- UR_Mul --
1100    ------------
1101
1102    function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
1103    begin
1104       return UR_From_Uint (Left) * Right;
1105    end UR_Mul;
1106
1107    function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
1108    begin
1109       return Left * UR_From_Uint (Right);
1110    end UR_Mul;
1111
1112    function UR_Mul (Left, Right : Ureal) return Ureal is
1113       Lval : constant Ureal_Entry := Ureals.Table (Left);
1114       Rval : constant Ureal_Entry := Ureals.Table (Right);
1115       Num  : Uint                 := Lval.Num * Rval.Num;
1116       Den  : Uint;
1117       Rneg : constant Boolean     := Lval.Negative xor Rval.Negative;
1118
1119    begin
1120       if Lval.Rbase = 0 then
1121          if Rval.Rbase = 0 then
1122             return Store_Ureal_Normalized
1123                      ((Num      => Num,
1124                        Den      => Lval.Den * Rval.Den,
1125                        Rbase    => 0,
1126                        Negative => Rneg));
1127
1128          elsif Is_Integer (Num, Lval.Den) then
1129             return Store_Ureal
1130                      ((Num      => Num / Lval.Den,
1131                        Den      => Rval.Den,
1132                        Rbase    => Rval.Rbase,
1133                        Negative => Rneg));
1134
1135          elsif Rval.Den < 0 then
1136             return Store_Ureal_Normalized
1137                      ((Num      => Num * (Rval.Rbase ** (-Rval.Den)),
1138                        Den      => Lval.Den,
1139                        Rbase    => 0,
1140                        Negative => Rneg));
1141
1142          else
1143             return Store_Ureal_Normalized
1144                      ((Num      => Num,
1145                        Den      => Lval.Den * (Rval.Rbase ** Rval.Den),
1146                        Rbase    => 0,
1147                        Negative => Rneg));
1148          end if;
1149
1150       elsif Lval.Rbase = Rval.Rbase then
1151          return Store_Ureal
1152                   ((Num      => Num,
1153                     Den      => Lval.Den + Rval.Den,
1154                     Rbase    => Lval.Rbase,
1155                     Negative => Rneg));
1156
1157       elsif Rval.Rbase = 0 then
1158          if Is_Integer (Num, Rval.Den) then
1159             return Store_Ureal
1160                      ((Num      => Num / Rval.Den,
1161                        Den      => Lval.Den,
1162                        Rbase    => Lval.Rbase,
1163                        Negative => Rneg));
1164
1165          elsif Lval.Den < 0 then
1166             return Store_Ureal_Normalized
1167                      ((Num      => Num * (Lval.Rbase ** (-Lval.Den)),
1168                        Den      => Rval.Den,
1169                        Rbase    => 0,
1170                        Negative => Rneg));
1171
1172          else
1173             return Store_Ureal_Normalized
1174                      ((Num      => Num,
1175                        Den      => Rval.Den * (Lval.Rbase ** Lval.Den),
1176                        Rbase    => 0,
1177                        Negative => Rneg));
1178          end if;
1179
1180       else
1181          Den := Uint_1;
1182
1183          if Lval.Den < 0 then
1184             Num := Num * (Lval.Rbase ** (-Lval.Den));
1185          else
1186             Den := Den * (Lval.Rbase ** Lval.Den);
1187          end if;
1188
1189          if Rval.Den < 0 then
1190             Num := Num * (Rval.Rbase ** (-Rval.Den));
1191          else
1192             Den := Den * (Rval.Rbase ** Rval.Den);
1193          end if;
1194
1195          return Store_Ureal_Normalized
1196                   ((Num      => Num,
1197                     Den      => Den,
1198                     Rbase    => 0,
1199                     Negative => Rneg));
1200       end if;
1201    end UR_Mul;
1202
1203    -----------
1204    -- UR_Ne --
1205    -----------
1206
1207    function UR_Ne (Left, Right : Ureal) return Boolean is
1208    begin
1209       --  Quick processing for case of identical Ureal values (note that
1210       --  this also deals with comparing two No_Ureal values).
1211
1212       if Same (Left, Right) then
1213          return False;
1214
1215       --  Deal with case of one or other operand is No_Ureal, but not both
1216
1217       elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
1218          return True;
1219
1220       --  Do quick check based on number of decimal digits
1221
1222       elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
1223             Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
1224       then
1225          return True;
1226
1227       --  Otherwise full comparison is required
1228
1229       else
1230          declare
1231             Imrk   : constant Uintp.Save_Mark  := Mark;
1232             Rmrk   : constant Urealp.Save_Mark := Mark;
1233             Lval   : constant Ureal_Entry := Normalize (Ureals.Table (Left));
1234             Rval   : constant Ureal_Entry := Normalize (Ureals.Table (Right));
1235             Result : Boolean;
1236
1237          begin
1238             if UR_Is_Zero (Left) then
1239                return not UR_Is_Zero (Right);
1240
1241             elsif UR_Is_Zero (Right) then
1242                return not UR_Is_Zero (Left);
1243
1244             --  Both operands are non-zero
1245
1246             else
1247                Result :=
1248                   Rval.Negative /= Lval.Negative
1249                     or else Rval.Num /= Lval.Num
1250                     or else Rval.Den /= Lval.Den;
1251                Release (Imrk);
1252                Release (Rmrk);
1253                return Result;
1254             end if;
1255          end;
1256       end if;
1257    end UR_Ne;
1258
1259    ---------------
1260    -- UR_Negate --
1261    ---------------
1262
1263    function UR_Negate (Real : Ureal) return Ureal is
1264    begin
1265       return Store_Ureal
1266                ((Num      => Ureals.Table (Real).Num,
1267                  Den      => Ureals.Table (Real).Den,
1268                  Rbase    => Ureals.Table (Real).Rbase,
1269                  Negative => not Ureals.Table (Real).Negative));
1270    end UR_Negate;
1271
1272    ------------
1273    -- UR_Sub --
1274    ------------
1275
1276    function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
1277    begin
1278       return UR_From_Uint (Left) + UR_Negate (Right);
1279    end UR_Sub;
1280
1281    function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
1282    begin
1283       return Left + UR_From_Uint (-Right);
1284    end UR_Sub;
1285
1286    function UR_Sub (Left, Right : Ureal) return Ureal is
1287    begin
1288       return Left + UR_Negate (Right);
1289    end UR_Sub;
1290
1291    ----------------
1292    -- UR_To_Uint --
1293    ----------------
1294
1295    function UR_To_Uint (Real : Ureal) return Uint is
1296       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1297       Res : Uint;
1298
1299    begin
1300       Res := (Val.Num + (Val.Den / 2)) / Val.Den;
1301
1302       if Val.Negative then
1303          return UI_Negate (Res);
1304       else
1305          return Res;
1306       end if;
1307    end UR_To_Uint;
1308
1309    --------------
1310    -- UR_Trunc --
1311    --------------
1312
1313    function UR_Trunc (Real : Ureal) return Uint is
1314       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1315    begin
1316       if Val.Negative then
1317          return -(Val.Num / Val.Den);
1318       else
1319          return Val.Num / Val.Den;
1320       end if;
1321    end UR_Trunc;
1322
1323    --------------
1324    -- UR_Write --
1325    --------------
1326
1327    procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is
1328       Val : constant Ureal_Entry := Ureals.Table (Real);
1329       T   : Uint;
1330
1331    begin
1332       --  If value is negative, we precede the constant by a minus sign
1333
1334       if Val.Negative then
1335          Write_Char ('-');
1336       end if;
1337
1338       --  Zero is zero
1339
1340       if Val.Num = 0 then
1341          Write_Str ("0.0");
1342
1343       --  For constants with a denominator of zero, the value is simply the
1344       --  numerator value, since we are dividing by base**0, which is 1.
1345
1346       elsif Val.Den = 0 then
1347          UI_Write (Val.Num, Decimal);
1348          Write_Str (".0");
1349
1350       --  Small powers of 2 get written in decimal fixed-point format
1351
1352       elsif Val.Rbase = 2
1353         and then Val.Den <= 3
1354         and then Val.Den >= -16
1355       then
1356          if Val.Den = 1 then
1357             T := Val.Num * (10 / 2);
1358             UI_Write (T / 10, Decimal);
1359             Write_Char ('.');
1360             UI_Write (T mod 10, Decimal);
1361
1362          elsif Val.Den = 2 then
1363             T := Val.Num * (100 / 4);
1364             UI_Write (T / 100, Decimal);
1365             Write_Char ('.');
1366             UI_Write (T mod 100 / 10, Decimal);
1367
1368             if T mod 10 /= 0 then
1369                UI_Write (T mod 10, Decimal);
1370             end if;
1371
1372          elsif Val.Den = 3 then
1373             T := Val.Num * (1000 / 8);
1374             UI_Write (T / 1000, Decimal);
1375             Write_Char ('.');
1376             UI_Write (T mod 1000 / 100, Decimal);
1377
1378             if T mod 100 /= 0 then
1379                UI_Write (T mod 100 / 10, Decimal);
1380
1381                if T mod 10 /= 0 then
1382                   UI_Write (T mod 10, Decimal);
1383                end if;
1384             end if;
1385
1386          else
1387             UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal);
1388             Write_Str (".0");
1389          end if;
1390
1391       --  Constants in base 10 or 16 can be written in normal Ada literal
1392       --  style, as long as they fit in the UI_Image_Buffer. Using hexadecimal
1393       --  notation, 4 bytes are required for the 16# # part, and every fifth
1394       --  character is an underscore. So, a buffer of size N has room for
1395       --     ((N - 4) - (N - 4) / 5) * 4 bits,
1396       --  or at least
1397       --     N * 16 / 5 - 12 bits.
1398
1399       elsif (Val.Rbase = 10 or else Val.Rbase = 16)
1400         and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12
1401       then
1402          pragma Assert (Val.Den /= 0);
1403
1404          --  Use fixed-point format for small scaling values
1405
1406          if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3)
1407               or else (Val.Rbase = 16 and then Val.Den = -1)
1408          then
1409             UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal);
1410             Write_Str (".0");
1411
1412          --  Write hexadecimal constants in exponential notation with a zero
1413          --  unit digit. This matches the Ada canonical form for floating point
1414          --  numbers, and also ensures that the underscores end up in the
1415          --  correct place.
1416
1417          elsif Val.Rbase = 16 then
1418             UI_Image (Val.Num, Hex);
1419             pragma Assert (Val.Rbase = 16);
1420
1421             Write_Str ("16#0.");
1422             Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
1423
1424             --  For exponent, exclude 16# # and underscores from length
1425
1426             UI_Image_Length := UI_Image_Length - 4;
1427             UI_Image_Length := UI_Image_Length - UI_Image_Length / 5;
1428
1429             Write_Char ('E');
1430             UI_Write (Int (UI_Image_Length) - Val.Den, Decimal);
1431
1432          elsif Val.Den = 1 then
1433             UI_Write (Val.Num / 10, Decimal);
1434             Write_Char ('.');
1435             UI_Write (Val.Num mod 10, Decimal);
1436
1437          elsif Val.Den = 2 then
1438             UI_Write (Val.Num / 100, Decimal);
1439             Write_Char ('.');
1440             UI_Write (Val.Num / 10 mod 10, Decimal);
1441             UI_Write (Val.Num mod 10, Decimal);
1442
1443          --  Else use decimal exponential format
1444
1445          else
1446             --  Write decimal constants with a non-zero unit digit. This
1447             --  matches usual scientific notation.
1448
1449             UI_Image (Val.Num, Decimal);
1450             Write_Char (UI_Image_Buffer (1));
1451             Write_Char ('.');
1452
1453             if UI_Image_Length = 1 then
1454                Write_Char ('0');
1455             else
1456                Write_Str (UI_Image_Buffer (2 .. UI_Image_Length));
1457             end if;
1458
1459             Write_Char ('E');
1460             UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal);
1461          end if;
1462
1463       --  Constants in a base other than 10 can still be easily written in
1464       --  normal Ada literal style if the numerator is one.
1465
1466       elsif Val.Rbase /= 0 and then Val.Num = 1 then
1467          Write_Int (Val.Rbase);
1468          Write_Str ("#1.0#E");
1469          UI_Write (-Val.Den);
1470
1471       --  Other constants with a base other than 10 are written using one of
1472       --  the following forms, depending on the sign of the number and the
1473       --  sign of the exponent (= minus denominator value). See that we are
1474       --  replacing the division by a multiplication (updating accordingly the
1475       --  sign of the exponent) to generate an expression whose computation
1476       --  does not cause a division by 0 when base**exponent is very small.
1477
1478       --    numerator.0*base**exponent
1479       --    numerator.0*base**-exponent
1480
1481       --  And of course an exponent of 0 can be omitted.
1482
1483       elsif Val.Rbase /= 0 then
1484          if Brackets then
1485             Write_Char ('[');
1486          end if;
1487
1488          UI_Write (Val.Num, Decimal);
1489          Write_Str (".0");
1490
1491          if Val.Den /= 0 then
1492             Write_Char ('*');
1493             Write_Int (Val.Rbase);
1494             Write_Str ("**");
1495
1496             if Val.Den <= 0 then
1497                UI_Write (-Val.Den, Decimal);
1498             else
1499                Write_Str ("(-");
1500                UI_Write (Val.Den, Decimal);
1501                Write_Char (')');
1502             end if;
1503          end if;
1504
1505          if Brackets then
1506             Write_Char (']');
1507          end if;
1508
1509       --  Rationals where numerator is divisible by denominator can be output
1510       --  as literals after we do the division. This includes the common case
1511       --  where the denominator is 1.
1512
1513       elsif Val.Num mod Val.Den = 0 then
1514          UI_Write (Val.Num / Val.Den, Decimal);
1515          Write_Str (".0");
1516
1517       --  Other non-based (rational) constants are written in num/den style
1518
1519       else
1520          if Brackets then
1521             Write_Char ('[');
1522          end if;
1523
1524          UI_Write (Val.Num, Decimal);
1525          Write_Str (".0/");
1526          UI_Write (Val.Den, Decimal);
1527          Write_Str (".0");
1528
1529          if Brackets then
1530             Write_Char (']');
1531          end if;
1532       end if;
1533    end UR_Write;
1534
1535    -------------
1536    -- Ureal_0 --
1537    -------------
1538
1539    function Ureal_0 return Ureal is
1540    begin
1541       return UR_0;
1542    end Ureal_0;
1543
1544    -------------
1545    -- Ureal_1 --
1546    -------------
1547
1548    function Ureal_1 return Ureal is
1549    begin
1550       return UR_1;
1551    end Ureal_1;
1552
1553    -------------
1554    -- Ureal_2 --
1555    -------------
1556
1557    function Ureal_2 return Ureal is
1558    begin
1559       return UR_2;
1560    end Ureal_2;
1561
1562    --------------
1563    -- Ureal_10 --
1564    --------------
1565
1566    function Ureal_10 return Ureal is
1567    begin
1568       return UR_10;
1569    end Ureal_10;
1570
1571    ---------------
1572    -- Ureal_100 --
1573    ---------------
1574
1575    function Ureal_100 return Ureal is
1576    begin
1577       return UR_100;
1578    end Ureal_100;
1579
1580    -----------------
1581    -- Ureal_10_36 --
1582    -----------------
1583
1584    function Ureal_10_36 return Ureal is
1585    begin
1586       return UR_10_36;
1587    end Ureal_10_36;
1588
1589    ----------------
1590    -- Ureal_2_80 --
1591    ----------------
1592
1593    function Ureal_2_80 return Ureal is
1594    begin
1595       return UR_2_80;
1596    end Ureal_2_80;
1597
1598    -----------------
1599    -- Ureal_2_128 --
1600    -----------------
1601
1602    function Ureal_2_128 return Ureal is
1603    begin
1604       return UR_2_128;
1605    end Ureal_2_128;
1606
1607    -------------------
1608    -- Ureal_2_M_80 --
1609    -------------------
1610
1611    function Ureal_2_M_80 return Ureal is
1612    begin
1613       return UR_2_M_80;
1614    end Ureal_2_M_80;
1615
1616    -------------------
1617    -- Ureal_2_M_128 --
1618    -------------------
1619
1620    function Ureal_2_M_128 return Ureal is
1621    begin
1622       return UR_2_M_128;
1623    end Ureal_2_M_128;
1624
1625    ----------------
1626    -- Ureal_Half --
1627    ----------------
1628
1629    function Ureal_Half return Ureal is
1630    begin
1631       return UR_Half;
1632    end Ureal_Half;
1633
1634    ---------------
1635    -- Ureal_M_0 --
1636    ---------------
1637
1638    function Ureal_M_0 return Ureal is
1639    begin
1640       return UR_M_0;
1641    end Ureal_M_0;
1642
1643    -------------------
1644    -- Ureal_M_10_36 --
1645    -------------------
1646
1647    function Ureal_M_10_36 return Ureal is
1648    begin
1649       return UR_M_10_36;
1650    end Ureal_M_10_36;
1651
1652    -----------------
1653    -- Ureal_Tenth --
1654    -----------------
1655
1656    function Ureal_Tenth return Ureal is
1657    begin
1658       return UR_Tenth;
1659    end Ureal_Tenth;
1660
1661 end Urealp;