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-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with 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    --  to the nearest integer, and so can be one off.
 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       --  The following table is a table of logs to the base 10
 248
 249       Logs : constant array (Nat range 1 .. 16) of Long_Float := (
 250                 1 => 0.000000000000000,
 251                 2 => 0.301029995663981,
 252                 3 => 0.477121254719662,
 253                 4 => 0.602059991327962,
 254                 5 => 0.698970004336019,
 255                 6 => 0.778151250383644,
 256                 7 => 0.845098040014257,
 257                 8 => 0.903089986991944,
 258                 9 => 0.954242509439325,
 259                10 => 1.000000000000000,
 260                11 => 1.041392685158230,
 261                12 => 1.079181246047620,
 262                13 => 1.113943352306840,
 263                14 => 1.146128035678240,
 264                15 => 1.176091259055680,
 265                16 => 1.204119982655920);
 266
 267    begin
 268       pragma Assert (U.Rbase /= 0);
 269       return Int (Long_Float (UI_To_Int (U.Den)) * Logs (U.Rbase));
 270    end Equivalent_Decimal_Exponent;
 271
 272    ----------------
 273    -- Initialize --
 274    ----------------
 275
 276    procedure Initialize is
 277    begin
 278       Ureals.Init;
 279       UR_0       := UR_From_Components (Uint_0, Uint_1,         0, False);
 280       UR_M_0     := UR_From_Components (Uint_0, Uint_1,         0, True);
 281       UR_Half    := UR_From_Components (Uint_1, Uint_1,         2, False);
 282       UR_Tenth   := UR_From_Components (Uint_1, Uint_1,        10, False);
 283       UR_1       := UR_From_Components (Uint_1, Uint_1,         0, False);
 284       UR_2       := UR_From_Components (Uint_1, Uint_Minus_1,   2, False);
 285       UR_10      := UR_From_Components (Uint_1, Uint_Minus_1,  10, False);
 286       UR_10_36   := UR_From_Components (Uint_1, Uint_Minus_36, 10, False);
 287       UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True);
 288       UR_100     := UR_From_Components (Uint_1, Uint_Minus_2,  10, False);
 289       UR_2_128   := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);
 290       UR_2_M_128 := UR_From_Components (Uint_1, Uint_128,       2, False);
 291       UR_2_80    := UR_From_Components (Uint_1, Uint_Minus_80,  2, False);
 292       UR_2_M_80  := UR_From_Components (Uint_1, Uint_80,        2, False);
 293    end Initialize;
 294
 295    ----------------
 296    -- Is_Integer --
 297    ----------------
 298
 299    function Is_Integer (Num, Den : Uint) return Boolean is
 300    begin
 301       return (Num / Den) * Den = Num;
 302    end Is_Integer;
 303
 304    ----------
 305    -- Mark --
 306    ----------
 307
 308    function Mark return Save_Mark is
 309    begin
 310       return Save_Mark (Ureals.Last);
 311    end Mark;
 312
 313    --------------
 314    -- Norm_Den --
 315    --------------
 316
 317    function Norm_Den (Real : Ureal) return Uint is
 318    begin
 319       if not Same (Real, Normalized_Real) then
 320          Normalized_Real  := Real;
 321          Normalized_Entry := Normalize (Ureals.Table (Real));
 322       end if;
 323
 324       return Normalized_Entry.Den;
 325    end Norm_Den;
 326
 327    --------------
 328    -- Norm_Num --
 329    --------------
 330
 331    function Norm_Num (Real : Ureal) return Uint is
 332    begin
 333       if not Same (Real, Normalized_Real) then
 334          Normalized_Real  := Real;
 335          Normalized_Entry := Normalize (Ureals.Table (Real));
 336       end if;
 337
 338       return Normalized_Entry.Num;
 339    end Norm_Num;
 340
 341    ---------------
 342    -- Normalize --
 343    ---------------
 344
 345    function Normalize (Val : Ureal_Entry) return Ureal_Entry is
 346       J   : Uint;
 347       K   : Uint;
 348       Tmp : Uint;
 349       Num : Uint;
 350       Den : Uint;
 351       M   : constant Uintp.Save_Mark := Uintp.Mark;
 352
 353    begin
 354       --  Start by setting J to the greatest of the absolute values of the
 355       --  numerator and the denominator (taking into account the base value),
 356       --  and K to the lesser of the two absolute values. The gcd of Num and
 357       --  Den is the gcd of J and K.
 358
 359       if Val.Rbase = 0 then
 360          J := Val.Num;
 361          K := Val.Den;
 362
 363       elsif Val.Den < 0 then
 364          J := Val.Num * Val.Rbase ** (-Val.Den);
 365          K := Uint_1;
 366
 367       else
 368          J := Val.Num;
 369          K := Val.Rbase ** Val.Den;
 370       end if;
 371
 372       Num := J;
 373       Den := K;
 374
 375       if K > J then
 376          Tmp := J;
 377          J := K;
 378          K := Tmp;
 379       end if;
 380
 381       J := UI_GCD (J, K);
 382       Num := Num / J;
 383       Den := Den / J;
 384       Uintp.Release_And_Save (M, Num, Den);
 385
 386       --  Divide numerator and denominator by gcd and return result
 387
 388       return (Num      => Num,
 389               Den      => Den,
 390               Rbase    => 0,
 391               Negative => Val.Negative);
 392    end Normalize;
 393
 394    ---------------
 395    -- Numerator --
 396    ---------------
 397
 398    function Numerator (Real : Ureal) return Uint is
 399    begin
 400       return Ureals.Table (Real).Num;
 401    end Numerator;
 402
 403    --------
 404    -- pr --
 405    --------
 406
 407    procedure pr (Real : Ureal) is
 408    begin
 409       UR_Write (Real);
 410       Write_Eol;
 411    end pr;
 412
 413    -----------
 414    -- Rbase --
 415    -----------
 416
 417    function Rbase (Real : Ureal) return Nat is
 418    begin
 419       return Ureals.Table (Real).Rbase;
 420    end Rbase;
 421
 422    -------------
 423    -- Release --
 424    -------------
 425
 426    procedure Release (M : Save_Mark) is
 427    begin
 428       Ureals.Set_Last (Ureal (M));
 429    end Release;
 430
 431    ----------
 432    -- Same --
 433    ----------
 434
 435    function Same (U1, U2 : Ureal) return Boolean is
 436    begin
 437       return Int (U1) = Int (U2);
 438    end Same;
 439
 440    -----------------
 441    -- Store_Ureal --
 442    -----------------
 443
 444    function Store_Ureal (Val : Ureal_Entry) return Ureal is
 445    begin
 446       Ureals.Append (Val);
 447
 448       --  Normalize representation of signed values
 449
 450       if Val.Num < 0 then
 451          Ureals.Table (Ureals.Last).Negative := True;
 452          Ureals.Table (Ureals.Last).Num := -Val.Num;
 453       end if;
 454
 455       return Ureals.Last;
 456    end Store_Ureal;
 457
 458    ----------------------------
 459    -- Store_Ureal_Normalized --
 460    ----------------------------
 461
 462    function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is
 463    begin
 464       return Store_Ureal (Normalize (Val));
 465    end Store_Ureal_Normalized;
 466
 467    ---------------
 468    -- Tree_Read --
 469    ---------------
 470
 471    procedure Tree_Read is
 472    begin
 473       pragma Assert (Num_Ureal_Constants = 10);
 474
 475       Ureals.Tree_Read;
 476       Tree_Read_Int (Int (UR_0));
 477       Tree_Read_Int (Int (UR_M_0));
 478       Tree_Read_Int (Int (UR_Tenth));
 479       Tree_Read_Int (Int (UR_Half));
 480       Tree_Read_Int (Int (UR_1));
 481       Tree_Read_Int (Int (UR_2));
 482       Tree_Read_Int (Int (UR_10));
 483       Tree_Read_Int (Int (UR_100));
 484       Tree_Read_Int (Int (UR_2_128));
 485       Tree_Read_Int (Int (UR_2_M_128));
 486
 487       --  Clear the normalization cache
 488
 489       Normalized_Real := No_Ureal;
 490    end Tree_Read;
 491
 492    ----------------
 493    -- Tree_Write --
 494    ----------------
 495
 496    procedure Tree_Write is
 497    begin
 498       pragma Assert (Num_Ureal_Constants = 10);
 499
 500       Ureals.Tree_Write;
 501       Tree_Write_Int (Int (UR_0));
 502       Tree_Write_Int (Int (UR_M_0));
 503       Tree_Write_Int (Int (UR_Tenth));
 504       Tree_Write_Int (Int (UR_Half));
 505       Tree_Write_Int (Int (UR_1));
 506       Tree_Write_Int (Int (UR_2));
 507       Tree_Write_Int (Int (UR_10));
 508       Tree_Write_Int (Int (UR_100));
 509       Tree_Write_Int (Int (UR_2_128));
 510       Tree_Write_Int (Int (UR_2_M_128));
 511    end Tree_Write;
 512
 513    ------------
 514    -- UR_Abs --
 515    ------------
 516
 517    function UR_Abs (Real : Ureal) return Ureal is
 518       Val : constant Ureal_Entry := Ureals.Table (Real);
 519
 520    begin
 521       return Store_Ureal
 522                ((Num      => Val.Num,
 523                  Den      => Val.Den,
 524                  Rbase    => Val.Rbase,
 525                  Negative => False));
 526    end UR_Abs;
 527
 528    ------------
 529    -- UR_Add --
 530    ------------
 531
 532    function UR_Add (Left : Uint; Right : Ureal) return Ureal is
 533    begin
 534       return UR_From_Uint (Left) + Right;
 535    end UR_Add;
 536
 537    function UR_Add (Left : Ureal; Right : Uint) return Ureal is
 538    begin
 539       return Left + UR_From_Uint (Right);
 540    end UR_Add;
 541
 542    function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
 543       Lval : Ureal_Entry := Ureals.Table (Left);
 544       Rval : Ureal_Entry := Ureals.Table (Right);
 545       Num  : Uint;
 546
 547    begin
 548       --  Note, in the temporary Ureal_Entry values used in this procedure,
 549       --  we store the sign as the sign of the numerator (i.e. xxx.Num may
 550       --  be negative, even though in stored entries this can never be so)
 551
 552       if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
 553          declare
 554             Opd_Min, Opd_Max   : Ureal_Entry;
 555             Exp_Min, Exp_Max   : Uint;
 556
 557          begin
 558             if Lval.Negative then
 559                Lval.Num := (-Lval.Num);
 560             end if;
 561
 562             if Rval.Negative then
 563                Rval.Num := (-Rval.Num);
 564             end if;
 565
 566             if Lval.Den < Rval.Den then
 567                Exp_Min := Lval.Den;
 568                Exp_Max := Rval.Den;
 569                Opd_Min := Lval;
 570                Opd_Max := Rval;
 571             else
 572                Exp_Min := Rval.Den;
 573                Exp_Max := Lval.Den;
 574                Opd_Min := Rval;
 575                Opd_Max := Lval;
 576             end if;
 577
 578             Num :=
 579               Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
 580
 581             if Num = 0 then
 582                return Store_Ureal
 583                         ((Num      => Uint_0,
 584                           Den      => Uint_1,
 585                           Rbase    => 0,
 586                           Negative => Lval.Negative));
 587
 588             else
 589                return Store_Ureal
 590                         ((Num      => abs Num,
 591                           Den      => Exp_Max,
 592                           Rbase    => Lval.Rbase,
 593                           Negative => (Num < 0)));
 594             end if;
 595          end;
 596
 597       else
 598          declare
 599             Ln : Ureal_Entry := Normalize (Lval);
 600             Rn : Ureal_Entry := Normalize (Rval);
 601
 602          begin
 603             if Ln.Negative then
 604                Ln.Num := (-Ln.Num);
 605             end if;
 606
 607             if Rn.Negative then
 608                Rn.Num := (-Rn.Num);
 609             end if;
 610
 611             Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
 612
 613             if Num = 0 then
 614                return Store_Ureal
 615                         ((Num      => Uint_0,
 616                           Den      => Uint_1,
 617                           Rbase    => 0,
 618                           Negative => Lval.Negative));
 619
 620             else
 621                return Store_Ureal_Normalized
 622                         ((Num      => abs Num,
 623                           Den      => Ln.Den * Rn.Den,
 624                           Rbase    => 0,
 625                           Negative => (Num < 0)));
 626             end if;
 627          end;
 628       end if;
 629    end UR_Add;
 630
 631    ----------------
 632    -- UR_Ceiling --
 633    ----------------
 634
 635    function UR_Ceiling (Real : Ureal) return Uint is
 636       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
 637    begin
 638       if Val.Negative then
 639          return UI_Negate (Val.Num / Val.Den);
 640       else
 641          return (Val.Num + Val.Den - 1) / Val.Den;
 642       end if;
 643    end UR_Ceiling;
 644
 645    ------------
 646    -- UR_Div --
 647    ------------
 648
 649    function UR_Div (Left : Uint; Right : Ureal) return Ureal is
 650    begin
 651       return UR_From_Uint (Left) / Right;
 652    end UR_Div;
 653
 654    function UR_Div (Left : Ureal; Right : Uint) return Ureal is
 655    begin
 656       return Left / UR_From_Uint (Right);
 657    end UR_Div;
 658
 659    function UR_Div (Left, Right : Ureal) return Ureal is
 660       Lval : constant Ureal_Entry := Ureals.Table (Left);
 661       Rval : constant Ureal_Entry := Ureals.Table (Right);
 662       Rneg : constant Boolean     := Rval.Negative xor Lval.Negative;
 663
 664    begin
 665       pragma Assert (Rval.Num /= Uint_0);
 666
 667       if Lval.Rbase = 0 then
 668          if Rval.Rbase = 0 then
 669             return Store_Ureal_Normalized
 670                      ((Num      => Lval.Num * Rval.Den,
 671                        Den      => Lval.Den * Rval.Num,
 672                        Rbase    => 0,
 673                        Negative => Rneg));
 674
 675          elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
 676             return Store_Ureal
 677                      ((Num      => Lval.Num / (Rval.Num * Lval.Den),
 678                        Den      => (-Rval.Den),
 679                        Rbase    => Rval.Rbase,
 680                        Negative => Rneg));
 681
 682          elsif Rval.Den < 0 then
 683             return Store_Ureal_Normalized
 684                      ((Num      => Lval.Num,
 685                        Den      => Rval.Rbase ** (-Rval.Den) *
 686                                    Rval.Num *
 687                                    Lval.Den,
 688                        Rbase    => 0,
 689                        Negative => Rneg));
 690
 691          else
 692             return Store_Ureal_Normalized
 693                      ((Num      => Lval.Num * Rval.Rbase ** Rval.Den,
 694                        Den      => Rval.Num * Lval.Den,
 695                        Rbase    => 0,
 696                        Negative => Rneg));
 697          end if;
 698
 699       elsif Is_Integer (Lval.Num, Rval.Num) then
 700          if Rval.Rbase = Lval.Rbase then
 701             return Store_Ureal
 702                      ((Num      => Lval.Num / Rval.Num,
 703                        Den      => Lval.Den - Rval.Den,
 704                        Rbase    => Lval.Rbase,
 705                        Negative => Rneg));
 706
 707          elsif Rval.Rbase = 0 then
 708             return Store_Ureal
 709                      ((Num      => (Lval.Num / Rval.Num) * Rval.Den,
 710                        Den      => Lval.Den,
 711                        Rbase    => Lval.Rbase,
 712                        Negative => Rneg));
 713
 714          elsif Rval.Den < 0 then
 715             declare
 716                Num, Den : Uint;
 717
 718             begin
 719                if Lval.Den < 0 then
 720                   Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
 721                   Den := Rval.Rbase ** (-Rval.Den);
 722                else
 723                   Num := Lval.Num / Rval.Num;
 724                   Den := (Lval.Rbase ** Lval.Den) *
 725                          (Rval.Rbase ** (-Rval.Den));
 726                end if;
 727
 728                return Store_Ureal
 729                         ((Num      => Num,
 730                           Den      => Den,
 731                           Rbase    => 0,
 732                           Negative => Rneg));
 733             end;
 734
 735          else
 736             return Store_Ureal
 737                      ((Num      => (Lval.Num / Rval.Num) *
 738                                    (Rval.Rbase ** Rval.Den),
 739                        Den      => Lval.Den,
 740                        Rbase    => Lval.Rbase,
 741                        Negative => Rneg));
 742          end if;
 743
 744       else
 745          declare
 746             Num, Den : Uint;
 747
 748          begin
 749             if Lval.Den < 0 then
 750                Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
 751                Den := Rval.Num;
 752             else
 753                Num := Lval.Num;
 754                Den := Rval.Num * (Lval.Rbase ** Lval.Den);
 755             end if;
 756
 757             if Rval.Rbase /= 0 then
 758                if Rval.Den < 0 then
 759                   Den := Den * (Rval.Rbase ** (-Rval.Den));
 760                else
 761                   Num := Num * (Rval.Rbase ** Rval.Den);
 762                end if;
 763
 764             else
 765                Num := Num * Rval.Den;
 766             end if;
 767
 768             return Store_Ureal_Normalized
 769                      ((Num      => Num,
 770                        Den      => Den,
 771                        Rbase    => 0,
 772                        Negative => Rneg));
 773          end;
 774       end if;
 775    end UR_Div;
 776
 777    -----------
 778    -- UR_Eq --
 779    -----------
 780
 781    function UR_Eq (Left, Right : Ureal) return Boolean is
 782    begin
 783       return not UR_Ne (Left, Right);
 784    end UR_Eq;
 785
 786    ---------------------
 787    -- UR_Exponentiate --
 788    ---------------------
 789
 790    function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
 791       X    : constant Uint := abs N;
 792       Bas  : Ureal;
 793       Val  : Ureal_Entry;
 794       Neg  : Boolean;
 795       IBas : Uint;
 796
 797    begin
 798       --  If base is negative, then the resulting sign depends on whether
 799       --  the exponent is even or odd (even => positive, odd = negative)
 800
 801       if UR_Is_Negative (Real) then
 802          Neg := (N mod 2) /= 0;
 803          Bas := UR_Negate (Real);
 804       else
 805          Neg := False;
 806          Bas := Real;
 807       end if;
 808
 809       Val := Ureals.Table (Bas);
 810
 811       --  If the base is a small integer, then we can return the result in
 812       --  exponential form, which can save a lot of time for junk exponents.
 813
 814       IBas := UR_Trunc (Bas);
 815
 816       if IBas <= 16
 817         and then UR_From_Uint (IBas) = Bas
 818       then
 819          return Store_Ureal
 820                   ((Num      => Uint_1,
 821                     Den      => -N,
 822                     Rbase    => UI_To_Int (UR_Trunc (Bas)),
 823                     Negative => Neg));
 824
 825       --  If the exponent is negative then we raise the numerator and the
 826       --  denominator (after normalization) to the absolute value of the
 827       --  exponent and we return the reciprocal. An assert error will happen
 828       --  if the numerator is zero.
 829
 830       elsif N < 0 then
 831          pragma Assert (Val.Num /= 0);
 832          Val := Normalize (Val);
 833
 834          return Store_Ureal
 835                   ((Num      => Val.Den ** X,
 836                     Den      => Val.Num ** X,
 837                     Rbase    => 0,
 838                     Negative => Neg));
 839
 840       --  If positive, we distinguish the case when the base is not zero, in
 841       --  which case the new denominator is just the product of the old one
 842       --  with the exponent,
 843
 844       else
 845          if Val.Rbase /= 0 then
 846
 847             return Store_Ureal
 848                      ((Num      => Val.Num ** X,
 849                        Den      => Val.Den * X,
 850                        Rbase    => Val.Rbase,
 851                        Negative => Neg));
 852
 853          --  And when the base is zero, in which case we exponentiate
 854          --  the old denominator.
 855
 856          else
 857             return Store_Ureal
 858                      ((Num      => Val.Num ** X,
 859                        Den      => Val.Den ** X,
 860                        Rbase    => 0,
 861                        Negative => Neg));
 862          end if;
 863       end if;
 864    end UR_Exponentiate;
 865
 866    --------------
 867    -- UR_Floor --
 868    --------------
 869
 870    function UR_Floor (Real : Ureal) return Uint is
 871       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
 872    begin
 873       if Val.Negative then
 874          return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
 875       else
 876          return Val.Num / Val.Den;
 877       end if;
 878    end UR_Floor;
 879
 880    ------------------------
 881    -- UR_From_Components --
 882    ------------------------
 883
 884    function UR_From_Components
 885      (Num      : Uint;
 886       Den      : Uint;
 887       Rbase    : Nat := 0;
 888       Negative : Boolean := False)
 889       return     Ureal
 890    is
 891    begin
 892       return Store_Ureal
 893                ((Num      => Num,
 894                  Den      => Den,
 895                  Rbase    => Rbase,
 896                  Negative => Negative));
 897    end UR_From_Components;
 898
 899    ------------------
 900    -- UR_From_Uint --
 901    ------------------
 902
 903    function UR_From_Uint (UI : Uint) return Ureal is
 904    begin
 905       return UR_From_Components
 906                (abs UI, Uint_1, Negative => (UI < 0));
 907    end UR_From_Uint;
 908
 909    -----------
 910    -- UR_Ge --
 911    -----------
 912
 913    function UR_Ge (Left, Right : Ureal) return Boolean is
 914    begin
 915       return not (Left < Right);
 916    end UR_Ge;
 917
 918    -----------
 919    -- UR_Gt --
 920    -----------
 921
 922    function UR_Gt (Left, Right : Ureal) return Boolean is
 923    begin
 924       return (Right < Left);
 925    end UR_Gt;
 926
 927    --------------------
 928    -- UR_Is_Negative --
 929    --------------------
 930
 931    function UR_Is_Negative (Real : Ureal) return Boolean is
 932    begin
 933       return Ureals.Table (Real).Negative;
 934    end UR_Is_Negative;
 935
 936    --------------------
 937    -- UR_Is_Positive --
 938    --------------------
 939
 940    function UR_Is_Positive (Real : Ureal) return Boolean is
 941    begin
 942       return not Ureals.Table (Real).Negative
 943         and then Ureals.Table (Real).Num /= 0;
 944    end UR_Is_Positive;
 945
 946    ----------------
 947    -- UR_Is_Zero --
 948    ----------------
 949
 950    function UR_Is_Zero (Real : Ureal) return Boolean is
 951    begin
 952       return Ureals.Table (Real).Num = 0;
 953    end UR_Is_Zero;
 954
 955    -----------
 956    -- UR_Le --
 957    -----------
 958
 959    function UR_Le (Left, Right : Ureal) return Boolean is
 960    begin
 961       return not (Right < Left);
 962    end UR_Le;
 963
 964    -----------
 965    -- UR_Lt --
 966    -----------
 967
 968    function UR_Lt (Left, Right : Ureal) return Boolean is
 969    begin
 970       --  An operand is not less than itself
 971
 972       if Same (Left, Right) then
 973          return False;
 974
 975       --  Deal with zero cases
 976
 977       elsif UR_Is_Zero (Left) then
 978          return UR_Is_Positive (Right);
 979
 980       elsif UR_Is_Zero (Right) then
 981          return Ureals.Table (Left).Negative;
 982
 983       --  Different signs are decisive (note we dealt with zero cases)
 984
 985       elsif Ureals.Table (Left).Negative
 986         and then not Ureals.Table (Right).Negative
 987       then
 988          return True;
 989
 990       elsif not Ureals.Table (Left).Negative
 991         and then Ureals.Table (Right).Negative
 992       then
 993          return False;
 994
 995       --  Signs are same, do rapid check based on worst case estimates of
 996       --  decimal exponent, which will often be decisive. Precise test
 997       --  depends on whether operands are positive or negative.
 998
 999       elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
1000          return UR_Is_Positive (Left);
1001
1002       elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
1003          return UR_Is_Negative (Left);
1004
1005       --  If we fall through, full gruesome test is required. This happens
1006       --  if the numbers are close together, or in some weird (/=10) base.
1007
1008       else
1009          declare
1010             Imrk   : constant Uintp.Save_Mark  := Mark;
1011             Rmrk   : constant Urealp.Save_Mark := Mark;
1012             Lval   : Ureal_Entry;
1013             Rval   : Ureal_Entry;
1014             Result : Boolean;
1015
1016          begin
1017             Lval := Ureals.Table (Left);
1018             Rval := Ureals.Table (Right);
1019
1020             --  An optimization. If both numbers are based, then subtract
1021             --  common value of base to avoid unnecessarily giant numbers
1022
1023             if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
1024                if Lval.Den < Rval.Den then
1025                   Rval.Den := Rval.Den - Lval.Den;
1026                   Lval.Den := Uint_0;
1027                else
1028                   Lval.Den := Lval.Den - Rval.Den;
1029                   Rval.Den := Uint_0;
1030                end if;
1031             end if;
1032
1033             Lval := Normalize (Lval);
1034             Rval := Normalize (Rval);
1035
1036             if Lval.Negative then
1037                Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
1038             else
1039                Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
1040             end if;
1041
1042             Release (Imrk);
1043             Release (Rmrk);
1044             return Result;
1045          end;
1046       end if;
1047    end UR_Lt;
1048
1049    ------------
1050    -- UR_Max --
1051    ------------
1052
1053    function UR_Max (Left, Right : Ureal) return Ureal is
1054    begin
1055       if Left >= Right then
1056          return Left;
1057       else
1058          return Right;
1059       end if;
1060    end UR_Max;
1061
1062    ------------
1063    -- UR_Min --
1064    ------------
1065
1066    function UR_Min (Left, Right : Ureal) return Ureal is
1067    begin
1068       if Left <= Right then
1069          return Left;
1070       else
1071          return Right;
1072       end if;
1073    end UR_Min;
1074
1075    ------------
1076    -- UR_Mul --
1077    ------------
1078
1079    function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
1080    begin
1081       return UR_From_Uint (Left) * Right;
1082    end UR_Mul;
1083
1084    function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
1085    begin
1086       return Left * UR_From_Uint (Right);
1087    end UR_Mul;
1088
1089    function UR_Mul (Left, Right : Ureal) return Ureal is
1090       Lval : constant Ureal_Entry := Ureals.Table (Left);
1091       Rval : constant Ureal_Entry := Ureals.Table (Right);
1092       Num  : Uint                 := Lval.Num * Rval.Num;
1093       Den  : Uint;
1094       Rneg : constant Boolean     := Lval.Negative xor Rval.Negative;
1095
1096    begin
1097       if Lval.Rbase = 0 then
1098          if Rval.Rbase = 0 then
1099             return Store_Ureal_Normalized
1100                      ((Num      => Num,
1101                        Den      => Lval.Den * Rval.Den,
1102                        Rbase    => 0,
1103                        Negative => Rneg));
1104
1105          elsif Is_Integer (Num, Lval.Den) then
1106             return Store_Ureal
1107                      ((Num      => Num / Lval.Den,
1108                        Den      => Rval.Den,
1109                        Rbase    => Rval.Rbase,
1110                        Negative => Rneg));
1111
1112          elsif Rval.Den < 0 then
1113             return Store_Ureal_Normalized
1114                      ((Num      => Num * (Rval.Rbase ** (-Rval.Den)),
1115                        Den      => Lval.Den,
1116                        Rbase    => 0,
1117                        Negative => Rneg));
1118
1119          else
1120             return Store_Ureal_Normalized
1121                      ((Num      => Num,
1122                        Den      => Lval.Den * (Rval.Rbase ** Rval.Den),
1123                        Rbase    => 0,
1124                        Negative => Rneg));
1125          end if;
1126
1127       elsif Lval.Rbase = Rval.Rbase then
1128          return Store_Ureal
1129                   ((Num      => Num,
1130                     Den      => Lval.Den + Rval.Den,
1131                     Rbase    => Lval.Rbase,
1132                     Negative => Rneg));
1133
1134       elsif Rval.Rbase = 0 then
1135          if Is_Integer (Num, Rval.Den) then
1136             return Store_Ureal
1137                      ((Num      => Num / Rval.Den,
1138                        Den      => Lval.Den,
1139                        Rbase    => Lval.Rbase,
1140                        Negative => Rneg));
1141
1142          elsif Lval.Den < 0 then
1143             return Store_Ureal_Normalized
1144                      ((Num      => Num * (Lval.Rbase ** (-Lval.Den)),
1145                        Den      => Rval.Den,
1146                        Rbase    => 0,
1147                        Negative => Rneg));
1148
1149          else
1150             return Store_Ureal_Normalized
1151                      ((Num      => Num,
1152                        Den      => Rval.Den * (Lval.Rbase ** Lval.Den),
1153                        Rbase    => 0,
1154                        Negative => Rneg));
1155          end if;
1156
1157       else
1158          Den := Uint_1;
1159
1160          if Lval.Den < 0 then
1161             Num := Num * (Lval.Rbase ** (-Lval.Den));
1162          else
1163             Den := Den * (Lval.Rbase ** Lval.Den);
1164          end if;
1165
1166          if Rval.Den < 0 then
1167             Num := Num * (Rval.Rbase ** (-Rval.Den));
1168          else
1169             Den := Den * (Rval.Rbase ** Rval.Den);
1170          end if;
1171
1172          return Store_Ureal_Normalized
1173                   ((Num      => Num,
1174                     Den      => Den,
1175                     Rbase    => 0,
1176                     Negative => Rneg));
1177       end if;
1178    end UR_Mul;
1179
1180    -----------
1181    -- UR_Ne --
1182    -----------
1183
1184    function UR_Ne (Left, Right : Ureal) return Boolean is
1185    begin
1186       --  Quick processing for case of identical Ureal values (note that
1187       --  this also deals with comparing two No_Ureal values).
1188
1189       if Same (Left, Right) then
1190          return False;
1191
1192       --  Deal with case of one or other operand is No_Ureal, but not both
1193
1194       elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
1195          return True;
1196
1197       --  Do quick check based on number of decimal digits
1198
1199       elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
1200             Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
1201       then
1202          return True;
1203
1204       --  Otherwise full comparison is required
1205
1206       else
1207          declare
1208             Imrk   : constant Uintp.Save_Mark  := Mark;
1209             Rmrk   : constant Urealp.Save_Mark := Mark;
1210             Lval   : constant Ureal_Entry := Normalize (Ureals.Table (Left));
1211             Rval   : constant Ureal_Entry := Normalize (Ureals.Table (Right));
1212             Result : Boolean;
1213
1214          begin
1215             if UR_Is_Zero (Left) then
1216                return not UR_Is_Zero (Right);
1217
1218             elsif UR_Is_Zero (Right) then
1219                return not UR_Is_Zero (Left);
1220
1221             --  Both operands are non-zero
1222
1223             else
1224                Result :=
1225                   Rval.Negative /= Lval.Negative
1226                     or else Rval.Num /= Lval.Num
1227                     or else Rval.Den /= Lval.Den;
1228                Release (Imrk);
1229                Release (Rmrk);
1230                return Result;
1231             end if;
1232          end;
1233       end if;
1234    end UR_Ne;
1235
1236    ---------------
1237    -- UR_Negate --
1238    ---------------
1239
1240    function UR_Negate (Real : Ureal) return Ureal is
1241    begin
1242       return Store_Ureal
1243                ((Num      => Ureals.Table (Real).Num,
1244                  Den      => Ureals.Table (Real).Den,
1245                  Rbase    => Ureals.Table (Real).Rbase,
1246                  Negative => not Ureals.Table (Real).Negative));
1247    end UR_Negate;
1248
1249    ------------
1250    -- UR_Sub --
1251    ------------
1252
1253    function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
1254    begin
1255       return UR_From_Uint (Left) + UR_Negate (Right);
1256    end UR_Sub;
1257
1258    function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
1259    begin
1260       return Left + UR_From_Uint (-Right);
1261    end UR_Sub;
1262
1263    function UR_Sub (Left, Right : Ureal) return Ureal is
1264    begin
1265       return Left + UR_Negate (Right);
1266    end UR_Sub;
1267
1268    ----------------
1269    -- UR_To_Uint --
1270    ----------------
1271
1272    function UR_To_Uint (Real : Ureal) return Uint is
1273       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1274       Res : Uint;
1275
1276    begin
1277       Res := (Val.Num + (Val.Den / 2)) / Val.Den;
1278
1279       if Val.Negative then
1280          return UI_Negate (Res);
1281       else
1282          return Res;
1283       end if;
1284    end UR_To_Uint;
1285
1286    --------------
1287    -- UR_Trunc --
1288    --------------
1289
1290    function UR_Trunc (Real : Ureal) return Uint is
1291       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1292    begin
1293       if Val.Negative then
1294          return -(Val.Num / Val.Den);
1295       else
1296          return Val.Num / Val.Den;
1297       end if;
1298    end UR_Trunc;
1299
1300    --------------
1301    -- UR_Write --
1302    --------------
1303
1304    procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is
1305       Val : constant Ureal_Entry := Ureals.Table (Real);
1306       T   : Uint;
1307
1308    begin
1309       --  If value is negative, we precede the constant by a minus sign
1310
1311       if Val.Negative then
1312          Write_Char ('-');
1313       end if;
1314
1315       --  Zero is zero
1316
1317       if Val.Num = 0 then
1318          Write_Str ("0.0");
1319
1320       --  For constants with a denominator of zero, the value is simply the
1321       --  numerator value, since we are dividing by base**0, which is 1.
1322
1323       elsif Val.Den = 0 then
1324          UI_Write (Val.Num, Decimal);
1325          Write_Str (".0");
1326
1327       --  Small powers of 2 get written in decimal fixed-point format
1328
1329       elsif Val.Rbase = 2
1330         and then Val.Den <= 3
1331         and then Val.Den >= -16
1332       then
1333          if Val.Den = 1 then
1334             T := Val.Num * (10/2);
1335             UI_Write (T / 10, Decimal);
1336             Write_Char ('.');
1337             UI_Write (T mod 10, Decimal);
1338
1339          elsif Val.Den = 2 then
1340             T := Val.Num * (100/4);
1341             UI_Write (T / 100, Decimal);
1342             Write_Char ('.');
1343             UI_Write (T mod 100 / 10, Decimal);
1344
1345             if T mod 10 /= 0 then
1346                UI_Write (T mod 10, Decimal);
1347             end if;
1348
1349          elsif Val.Den = 3 then
1350             T := Val.Num * (1000 / 8);
1351             UI_Write (T / 1000, Decimal);
1352             Write_Char ('.');
1353             UI_Write (T mod 1000 / 100, Decimal);
1354
1355             if T mod 100 /= 0 then
1356                UI_Write (T mod 100 / 10, Decimal);
1357
1358                if T mod 10 /= 0 then
1359                   UI_Write (T mod 10, Decimal);
1360                end if;
1361             end if;
1362
1363          else
1364             UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal);
1365             Write_Str (".0");
1366          end if;
1367
1368       --  Constants in base 10 or 16 can be written in normal Ada literal
1369       --  style, as long as they fit in the UI_Image_Buffer. Using hexadecimal
1370       --  notation, 4 bytes are required for the 16# # part, and every fifth
1371       --  character is an underscore. So, a buffer of size N has room for
1372       --     ((N - 4) - (N - 4) / 5) * 4 bits,
1373       --  or at least
1374       --     N * 16 / 5 - 12 bits.
1375
1376       elsif (Val.Rbase = 10 or else Val.Rbase = 16)
1377         and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12
1378       then
1379          pragma Assert (Val.Den /= 0);
1380
1381          --  Use fixed-point format for small scaling values
1382
1383          if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3)
1384               or else (Val.Rbase = 16 and then Val.Den = -1)
1385          then
1386             UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal);
1387             Write_Str (".0");
1388
1389          --  Write hexadecimal constants in exponential notation with a zero
1390          --  unit digit. This matches the Ada canonical form for floating point
1391          --  numbers, and also ensures that the underscores end up in the
1392          --  correct place.
1393
1394          elsif Val.Rbase = 16 then
1395             UI_Image (Val.Num, Hex);
1396             pragma Assert (Val.Rbase = 16);
1397
1398             Write_Str ("16#0.");
1399             Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
1400
1401             --  For exponent, exclude 16# # and underscores from length
1402
1403             UI_Image_Length := UI_Image_Length - 4;
1404             UI_Image_Length := UI_Image_Length - UI_Image_Length / 5;
1405
1406             Write_Char ('E');
1407             UI_Write (Int (UI_Image_Length) - Val.Den, Decimal);
1408
1409          elsif Val.Den = 1 then
1410             UI_Write (Val.Num / 10, Decimal);
1411             Write_Char ('.');
1412             UI_Write (Val.Num mod 10, Decimal);
1413
1414          elsif Val.Den = 2 then
1415             UI_Write (Val.Num / 100, Decimal);
1416             Write_Char ('.');
1417             UI_Write (Val.Num / 10 mod 10, Decimal);
1418             UI_Write (Val.Num mod 10, Decimal);
1419
1420          --  Else use decimal exponential format
1421
1422          else
1423             --  Write decimal constants with a non-zero unit digit. This
1424             --  matches usual scientific notation.
1425
1426             UI_Image (Val.Num, Decimal);
1427             Write_Char (UI_Image_Buffer (1));
1428             Write_Char ('.');
1429
1430             if UI_Image_Length = 1 then
1431                Write_Char ('0');
1432             else
1433                Write_Str (UI_Image_Buffer (2 .. UI_Image_Length));
1434             end if;
1435
1436             Write_Char ('E');
1437             UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal);
1438          end if;
1439
1440       --  Constants in a base other than 10 can still be easily written in
1441       --  normal Ada literal style if the numerator is one.
1442
1443       elsif Val.Rbase /= 0 and then Val.Num = 1 then
1444          Write_Int (Val.Rbase);
1445          Write_Str ("#1.0#E");
1446          UI_Write (-Val.Den);
1447
1448       --  Other constants with a base other than 10 are written using one
1449       --  of the following forms, depending on the sign of the number
1450       --  and the sign of the exponent (= minus denominator value)
1451
1452       --    numerator.0*base**exponent
1453       --    numerator.0*base**-exponent
1454
1455       --  And of course an exponent of 0 can be omitted
1456
1457       elsif Val.Rbase /= 0 then
1458          if Brackets then
1459             Write_Char ('[');
1460          end if;
1461
1462          UI_Write (Val.Num, Decimal);
1463          Write_Str (".0");
1464
1465          if Val.Den /= 0 then
1466             Write_Char ('*');
1467             Write_Int (Val.Rbase);
1468             Write_Str ("**");
1469
1470             if Val.Den <= 0 then
1471                UI_Write (-Val.Den, Decimal);
1472             else
1473                Write_Str ("(-");
1474                UI_Write (Val.Den, Decimal);
1475                Write_Char (')');
1476             end if;
1477          end if;
1478
1479          if Brackets then
1480             Write_Char (']');
1481          end if;
1482
1483       --  Rationals where numerator is divisible by denominator can be output
1484       --  as literals after we do the division. This includes the common case
1485       --  where the denominator is 1.
1486
1487       elsif Val.Num mod Val.Den = 0 then
1488          UI_Write (Val.Num / Val.Den, Decimal);
1489          Write_Str (".0");
1490
1491       --  Other non-based (rational) constants are written in num/den style
1492
1493       else
1494          if Brackets then
1495             Write_Char ('[');
1496          end if;
1497
1498          UI_Write (Val.Num, Decimal);
1499          Write_Str (".0/");
1500          UI_Write (Val.Den, Decimal);
1501          Write_Str (".0");
1502
1503          if Brackets then
1504             Write_Char (']');
1505          end if;
1506       end if;
1507    end UR_Write;
1508
1509    -------------
1510    -- Ureal_0 --
1511    -------------
1512
1513    function Ureal_0 return Ureal is
1514    begin
1515       return UR_0;
1516    end Ureal_0;
1517
1518    -------------
1519    -- Ureal_1 --
1520    -------------
1521
1522    function Ureal_1 return Ureal is
1523    begin
1524       return UR_1;
1525    end Ureal_1;
1526
1527    -------------
1528    -- Ureal_2 --
1529    -------------
1530
1531    function Ureal_2 return Ureal is
1532    begin
1533       return UR_2;
1534    end Ureal_2;
1535
1536    --------------
1537    -- Ureal_10 --
1538    --------------
1539
1540    function Ureal_10 return Ureal is
1541    begin
1542       return UR_10;
1543    end Ureal_10;
1544
1545    ---------------
1546    -- Ureal_100 --
1547    ---------------
1548
1549    function Ureal_100 return Ureal is
1550    begin
1551       return UR_100;
1552    end Ureal_100;
1553
1554    -----------------
1555    -- Ureal_10_36 --
1556    -----------------
1557
1558    function Ureal_10_36 return Ureal is
1559    begin
1560       return UR_10_36;
1561    end Ureal_10_36;
1562
1563    ----------------
1564    -- Ureal_2_80 --
1565    ----------------
1566
1567    function Ureal_2_80 return Ureal is
1568    begin
1569       return UR_2_80;
1570    end Ureal_2_80;
1571
1572    -----------------
1573    -- Ureal_2_128 --
1574    -----------------
1575
1576    function Ureal_2_128 return Ureal is
1577    begin
1578       return UR_2_128;
1579    end Ureal_2_128;
1580
1581    -------------------
1582    -- Ureal_2_M_80 --
1583    -------------------
1584
1585    function Ureal_2_M_80 return Ureal is
1586    begin
1587       return UR_2_M_80;
1588    end Ureal_2_M_80;
1589
1590    -------------------
1591    -- Ureal_2_M_128 --
1592    -------------------
1593
1594    function Ureal_2_M_128 return Ureal is
1595    begin
1596       return UR_2_M_128;
1597    end Ureal_2_M_128;
1598
1599    ----------------
1600    -- Ureal_Half --
1601    ----------------
1602
1603    function Ureal_Half return Ureal is
1604    begin
1605       return UR_Half;
1606    end Ureal_Half;
1607
1608    ---------------
1609    -- Ureal_M_0 --
1610    ---------------
1611
1612    function Ureal_M_0 return Ureal is
1613    begin
1614       return UR_M_0;
1615    end Ureal_M_0;
1616
1617    -------------------
1618    -- Ureal_M_10_36 --
1619    -------------------
1620
1621    function Ureal_M_10_36 return Ureal is
1622    begin
1623       return UR_M_10_36;
1624    end Ureal_M_10_36;
1625
1626    -----------------
1627    -- Ureal_Tenth --
1628    -----------------
1629
1630    function Ureal_Tenth return Ureal is
1631    begin
1632       return UR_Tenth;
1633    end Ureal_Tenth;
1634
1635 end Urealp;