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