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