1518 lines
43 KiB
Ada
1518 lines
43 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- U R E A L P --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
-- --
|
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
|
-- version 3.1, as published by the Free Software Foundation. --
|
|
-- --
|
|
-- You should have received a copy of the GNU General Public License and --
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Alloc;
|
|
with Output; use Output;
|
|
with Table;
|
|
with Tree_IO; use Tree_IO;
|
|
|
|
package body Urealp is
|
|
|
|
Ureal_First_Entry : constant Ureal := Ureal'Succ (No_Ureal);
|
|
-- First subscript allocated in Ureal table (note that we can't just
|
|
-- add 1 to No_Ureal, since "+" means something different for Ureals!
|
|
|
|
type Ureal_Entry is record
|
|
Num : Uint;
|
|
-- Numerator (always non-negative)
|
|
|
|
Den : Uint;
|
|
-- Denominator (always non-zero, always positive if base is zero)
|
|
|
|
Rbase : Nat;
|
|
-- Base value. If Rbase is zero, then the value is simply Num / Den.
|
|
-- If Rbase is non-zero, then the value is Num / (Rbase ** Den)
|
|
|
|
Negative : Boolean;
|
|
-- Flag set if value is negative
|
|
end record;
|
|
|
|
-- The following representation clause ensures that the above record
|
|
-- has no holes. We do this so that when instances of this record are
|
|
-- written by Tree_Gen, we do not write uninitialized values to the file.
|
|
|
|
for Ureal_Entry use record
|
|
Num at 0 range 0 .. 31;
|
|
Den at 4 range 0 .. 31;
|
|
Rbase at 8 range 0 .. 31;
|
|
Negative at 12 range 0 .. 31;
|
|
end record;
|
|
|
|
for Ureal_Entry'Size use 16 * 8;
|
|
-- This ensures that we did not leave out any fields
|
|
|
|
package Ureals is new Table.Table (
|
|
Table_Component_Type => Ureal_Entry,
|
|
Table_Index_Type => Ureal'Base,
|
|
Table_Low_Bound => Ureal_First_Entry,
|
|
Table_Initial => Alloc.Ureals_Initial,
|
|
Table_Increment => Alloc.Ureals_Increment,
|
|
Table_Name => "Ureals");
|
|
|
|
-- The following universal reals are the values returned by the constant
|
|
-- functions. They are initialized by the initialization procedure.
|
|
|
|
UR_0 : Ureal;
|
|
UR_M_0 : Ureal;
|
|
UR_Tenth : Ureal;
|
|
UR_Half : Ureal;
|
|
UR_1 : Ureal;
|
|
UR_2 : Ureal;
|
|
UR_10 : Ureal;
|
|
UR_10_36 : Ureal;
|
|
UR_M_10_36 : Ureal;
|
|
UR_100 : Ureal;
|
|
UR_2_128 : Ureal;
|
|
UR_2_80 : Ureal;
|
|
UR_2_M_128 : Ureal;
|
|
UR_2_M_80 : Ureal;
|
|
|
|
Num_Ureal_Constants : constant := 10;
|
|
-- This is used for an assertion check in Tree_Read and Tree_Write to
|
|
-- help remember to add values to these routines when we add to the list.
|
|
|
|
Normalized_Real : Ureal := No_Ureal;
|
|
-- Used to memoize Norm_Num and Norm_Den, if either of these functions
|
|
-- is called, this value is set and Normalized_Entry contains the result
|
|
-- of the normalization. On subsequent calls, this is used to avoid the
|
|
-- call to Normalize if it has already been made.
|
|
|
|
Normalized_Entry : Ureal_Entry;
|
|
-- Entry built by most recent call to Normalize
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
function Decimal_Exponent_Hi (V : Ureal) return Int;
|
|
-- Returns an estimate of the exponent of Val represented as a normalized
|
|
-- decimal number (non-zero digit before decimal point), The estimate is
|
|
-- either correct, or high, but never low. The accuracy of the estimate
|
|
-- affects only the efficiency of the comparison routines.
|
|
|
|
function Decimal_Exponent_Lo (V : Ureal) return Int;
|
|
-- Returns an estimate of the exponent of Val represented as a normalized
|
|
-- decimal number (non-zero digit before decimal point), The estimate is
|
|
-- either correct, or low, but never high. The accuracy of the estimate
|
|
-- affects only the efficiency of the comparison routines.
|
|
|
|
function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int;
|
|
-- U is a Ureal entry for which the base value is non-zero, the value
|
|
-- returned is the equivalent decimal exponent value, i.e. the value of
|
|
-- Den, adjusted as though the base were base 10. The value is rounded
|
|
-- to the nearest integer, and so can be one off.
|
|
|
|
function Is_Integer (Num, Den : Uint) return Boolean;
|
|
-- Return true if the real quotient of Num / Den is an integer value
|
|
|
|
function Normalize (Val : Ureal_Entry) return Ureal_Entry;
|
|
-- Normalizes the Ureal_Entry by reducing it to lowest terms (with a
|
|
-- base value of 0).
|
|
|
|
function Same (U1, U2 : Ureal) return Boolean;
|
|
pragma Inline (Same);
|
|
-- Determines if U1 and U2 are the same Ureal. Note that we cannot use
|
|
-- the equals operator for this test, since that tests for equality,
|
|
-- not identity.
|
|
|
|
function Store_Ureal (Val : Ureal_Entry) return Ureal;
|
|
-- This store a new entry in the universal reals table and return
|
|
-- its index in the table.
|
|
|
|
-------------------------
|
|
-- Decimal_Exponent_Hi --
|
|
-------------------------
|
|
|
|
function Decimal_Exponent_Hi (V : Ureal) return Int is
|
|
Val : constant Ureal_Entry := Ureals.Table (V);
|
|
|
|
begin
|
|
-- Zero always returns zero
|
|
|
|
if UR_Is_Zero (V) then
|
|
return 0;
|
|
|
|
-- For numbers in rational form, get the maximum number of digits in the
|
|
-- numerator and the minimum number of digits in the denominator, and
|
|
-- subtract. For example:
|
|
|
|
-- 1000 / 99 = 1.010E+1
|
|
-- 9999 / 10 = 9.999E+2
|
|
|
|
-- This estimate may of course be high, but that is acceptable
|
|
|
|
elsif Val.Rbase = 0 then
|
|
return UI_Decimal_Digits_Hi (Val.Num) -
|
|
UI_Decimal_Digits_Lo (Val.Den);
|
|
|
|
-- For based numbers, just subtract the decimal exponent from the
|
|
-- high estimate of the number of digits in the numerator and add
|
|
-- one to accommodate possible round off errors for non-decimal
|
|
-- bases. For example:
|
|
|
|
-- 1_500_000 / 10**4 = 1.50E-2
|
|
|
|
else -- Val.Rbase /= 0
|
|
return UI_Decimal_Digits_Hi (Val.Num) -
|
|
Equivalent_Decimal_Exponent (Val) + 1;
|
|
end if;
|
|
end Decimal_Exponent_Hi;
|
|
|
|
-------------------------
|
|
-- Decimal_Exponent_Lo --
|
|
-------------------------
|
|
|
|
function Decimal_Exponent_Lo (V : Ureal) return Int is
|
|
Val : constant Ureal_Entry := Ureals.Table (V);
|
|
|
|
begin
|
|
-- Zero always returns zero
|
|
|
|
if UR_Is_Zero (V) then
|
|
return 0;
|
|
|
|
-- For numbers in rational form, get min digits in numerator, max digits
|
|
-- in denominator, and subtract and subtract one more for possible loss
|
|
-- during the division. For example:
|
|
|
|
-- 1000 / 99 = 1.010E+1
|
|
-- 9999 / 10 = 9.999E+2
|
|
|
|
-- This estimate may of course be low, but that is acceptable
|
|
|
|
elsif Val.Rbase = 0 then
|
|
return UI_Decimal_Digits_Lo (Val.Num) -
|
|
UI_Decimal_Digits_Hi (Val.Den) - 1;
|
|
|
|
-- For based numbers, just subtract the decimal exponent from the
|
|
-- low estimate of the number of digits in the numerator and subtract
|
|
-- one to accommodate possible round off errors for non-decimal
|
|
-- bases. For example:
|
|
|
|
-- 1_500_000 / 10**4 = 1.50E-2
|
|
|
|
else -- Val.Rbase /= 0
|
|
return UI_Decimal_Digits_Lo (Val.Num) -
|
|
Equivalent_Decimal_Exponent (Val) - 1;
|
|
end if;
|
|
end Decimal_Exponent_Lo;
|
|
|
|
-----------------
|
|
-- Denominator --
|
|
-----------------
|
|
|
|
function Denominator (Real : Ureal) return Uint is
|
|
begin
|
|
return Ureals.Table (Real).Den;
|
|
end Denominator;
|
|
|
|
---------------------------------
|
|
-- Equivalent_Decimal_Exponent --
|
|
---------------------------------
|
|
|
|
function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is
|
|
|
|
-- The following table is a table of logs to the base 10
|
|
|
|
Logs : constant array (Nat range 1 .. 16) of Long_Float := (
|
|
1 => 0.000000000000000,
|
|
2 => 0.301029995663981,
|
|
3 => 0.477121254719662,
|
|
4 => 0.602059991327962,
|
|
5 => 0.698970004336019,
|
|
6 => 0.778151250383644,
|
|
7 => 0.845098040014257,
|
|
8 => 0.903089986991944,
|
|
9 => 0.954242509439325,
|
|
10 => 1.000000000000000,
|
|
11 => 1.041392685158230,
|
|
12 => 1.079181246047620,
|
|
13 => 1.113943352306840,
|
|
14 => 1.146128035678240,
|
|
15 => 1.176091259055680,
|
|
16 => 1.204119982655920);
|
|
|
|
begin
|
|
pragma Assert (U.Rbase /= 0);
|
|
return Int (Long_Float (UI_To_Int (U.Den)) * Logs (U.Rbase));
|
|
end Equivalent_Decimal_Exponent;
|
|
|
|
----------------
|
|
-- Initialize --
|
|
----------------
|
|
|
|
procedure Initialize is
|
|
begin
|
|
Ureals.Init;
|
|
UR_0 := UR_From_Components (Uint_0, Uint_1, 0, False);
|
|
UR_M_0 := UR_From_Components (Uint_0, Uint_1, 0, True);
|
|
UR_Half := UR_From_Components (Uint_1, Uint_1, 2, False);
|
|
UR_Tenth := UR_From_Components (Uint_1, Uint_1, 10, False);
|
|
UR_1 := UR_From_Components (Uint_1, Uint_1, 0, False);
|
|
UR_2 := UR_From_Components (Uint_1, Uint_Minus_1, 2, False);
|
|
UR_10 := UR_From_Components (Uint_1, Uint_Minus_1, 10, False);
|
|
UR_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, False);
|
|
UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True);
|
|
UR_100 := UR_From_Components (Uint_1, Uint_Minus_2, 10, False);
|
|
UR_2_128 := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);
|
|
UR_2_M_128 := UR_From_Components (Uint_1, Uint_128, 2, False);
|
|
UR_2_80 := UR_From_Components (Uint_1, Uint_Minus_80, 2, False);
|
|
UR_2_M_80 := UR_From_Components (Uint_1, Uint_80, 2, False);
|
|
end Initialize;
|
|
|
|
----------------
|
|
-- Is_Integer --
|
|
----------------
|
|
|
|
function Is_Integer (Num, Den : Uint) return Boolean is
|
|
begin
|
|
return (Num / Den) * Den = Num;
|
|
end Is_Integer;
|
|
|
|
----------
|
|
-- Mark --
|
|
----------
|
|
|
|
function Mark return Save_Mark is
|
|
begin
|
|
return Save_Mark (Ureals.Last);
|
|
end Mark;
|
|
|
|
--------------
|
|
-- Norm_Den --
|
|
--------------
|
|
|
|
function Norm_Den (Real : Ureal) return Uint is
|
|
begin
|
|
if not Same (Real, Normalized_Real) then
|
|
Normalized_Real := Real;
|
|
Normalized_Entry := Normalize (Ureals.Table (Real));
|
|
end if;
|
|
|
|
return Normalized_Entry.Den;
|
|
end Norm_Den;
|
|
|
|
--------------
|
|
-- Norm_Num --
|
|
--------------
|
|
|
|
function Norm_Num (Real : Ureal) return Uint is
|
|
begin
|
|
if not Same (Real, Normalized_Real) then
|
|
Normalized_Real := Real;
|
|
Normalized_Entry := Normalize (Ureals.Table (Real));
|
|
end if;
|
|
|
|
return Normalized_Entry.Num;
|
|
end Norm_Num;
|
|
|
|
---------------
|
|
-- Normalize --
|
|
---------------
|
|
|
|
function Normalize (Val : Ureal_Entry) return Ureal_Entry is
|
|
J : Uint;
|
|
K : Uint;
|
|
Tmp : Uint;
|
|
Num : Uint;
|
|
Den : Uint;
|
|
M : constant Uintp.Save_Mark := Uintp.Mark;
|
|
|
|
begin
|
|
-- Start by setting J to the greatest of the absolute values of the
|
|
-- numerator and the denominator (taking into account the base value),
|
|
-- and K to the lesser of the two absolute values. The gcd of Num and
|
|
-- Den is the gcd of J and K.
|
|
|
|
if Val.Rbase = 0 then
|
|
J := Val.Num;
|
|
K := Val.Den;
|
|
|
|
elsif Val.Den < 0 then
|
|
J := Val.Num * Val.Rbase ** (-Val.Den);
|
|
K := Uint_1;
|
|
|
|
else
|
|
J := Val.Num;
|
|
K := Val.Rbase ** Val.Den;
|
|
end if;
|
|
|
|
Num := J;
|
|
Den := K;
|
|
|
|
if K > J then
|
|
Tmp := J;
|
|
J := K;
|
|
K := Tmp;
|
|
end if;
|
|
|
|
J := UI_GCD (J, K);
|
|
Num := Num / J;
|
|
Den := Den / J;
|
|
Uintp.Release_And_Save (M, Num, Den);
|
|
|
|
-- Divide numerator and denominator by gcd and return result
|
|
|
|
return (Num => Num,
|
|
Den => Den,
|
|
Rbase => 0,
|
|
Negative => Val.Negative);
|
|
end Normalize;
|
|
|
|
---------------
|
|
-- Numerator --
|
|
---------------
|
|
|
|
function Numerator (Real : Ureal) return Uint is
|
|
begin
|
|
return Ureals.Table (Real).Num;
|
|
end Numerator;
|
|
|
|
--------
|
|
-- pr --
|
|
--------
|
|
|
|
procedure pr (Real : Ureal) is
|
|
begin
|
|
UR_Write (Real);
|
|
Write_Eol;
|
|
end pr;
|
|
|
|
-----------
|
|
-- Rbase --
|
|
-----------
|
|
|
|
function Rbase (Real : Ureal) return Nat is
|
|
begin
|
|
return Ureals.Table (Real).Rbase;
|
|
end Rbase;
|
|
|
|
-------------
|
|
-- Release --
|
|
-------------
|
|
|
|
procedure Release (M : Save_Mark) is
|
|
begin
|
|
Ureals.Set_Last (Ureal (M));
|
|
end Release;
|
|
|
|
----------
|
|
-- Same --
|
|
----------
|
|
|
|
function Same (U1, U2 : Ureal) return Boolean is
|
|
begin
|
|
return Int (U1) = Int (U2);
|
|
end Same;
|
|
|
|
-----------------
|
|
-- Store_Ureal --
|
|
-----------------
|
|
|
|
function Store_Ureal (Val : Ureal_Entry) return Ureal is
|
|
begin
|
|
Ureals.Append (Val);
|
|
|
|
-- Normalize representation of signed values
|
|
|
|
if Val.Num < 0 then
|
|
Ureals.Table (Ureals.Last).Negative := True;
|
|
Ureals.Table (Ureals.Last).Num := -Val.Num;
|
|
end if;
|
|
|
|
return Ureals.Last;
|
|
end Store_Ureal;
|
|
|
|
---------------
|
|
-- Tree_Read --
|
|
---------------
|
|
|
|
procedure Tree_Read is
|
|
begin
|
|
pragma Assert (Num_Ureal_Constants = 10);
|
|
|
|
Ureals.Tree_Read;
|
|
Tree_Read_Int (Int (UR_0));
|
|
Tree_Read_Int (Int (UR_M_0));
|
|
Tree_Read_Int (Int (UR_Tenth));
|
|
Tree_Read_Int (Int (UR_Half));
|
|
Tree_Read_Int (Int (UR_1));
|
|
Tree_Read_Int (Int (UR_2));
|
|
Tree_Read_Int (Int (UR_10));
|
|
Tree_Read_Int (Int (UR_100));
|
|
Tree_Read_Int (Int (UR_2_128));
|
|
Tree_Read_Int (Int (UR_2_M_128));
|
|
|
|
-- Clear the normalization cache
|
|
|
|
Normalized_Real := No_Ureal;
|
|
end Tree_Read;
|
|
|
|
----------------
|
|
-- Tree_Write --
|
|
----------------
|
|
|
|
procedure Tree_Write is
|
|
begin
|
|
pragma Assert (Num_Ureal_Constants = 10);
|
|
|
|
Ureals.Tree_Write;
|
|
Tree_Write_Int (Int (UR_0));
|
|
Tree_Write_Int (Int (UR_M_0));
|
|
Tree_Write_Int (Int (UR_Tenth));
|
|
Tree_Write_Int (Int (UR_Half));
|
|
Tree_Write_Int (Int (UR_1));
|
|
Tree_Write_Int (Int (UR_2));
|
|
Tree_Write_Int (Int (UR_10));
|
|
Tree_Write_Int (Int (UR_100));
|
|
Tree_Write_Int (Int (UR_2_128));
|
|
Tree_Write_Int (Int (UR_2_M_128));
|
|
end Tree_Write;
|
|
|
|
------------
|
|
-- UR_Abs --
|
|
------------
|
|
|
|
function UR_Abs (Real : Ureal) return Ureal is
|
|
Val : constant Ureal_Entry := Ureals.Table (Real);
|
|
|
|
begin
|
|
return Store_Ureal (
|
|
(Num => Val.Num,
|
|
Den => Val.Den,
|
|
Rbase => Val.Rbase,
|
|
Negative => False));
|
|
end UR_Abs;
|
|
|
|
------------
|
|
-- UR_Add --
|
|
------------
|
|
|
|
function UR_Add (Left : Uint; Right : Ureal) return Ureal is
|
|
begin
|
|
return UR_From_Uint (Left) + Right;
|
|
end UR_Add;
|
|
|
|
function UR_Add (Left : Ureal; Right : Uint) return Ureal is
|
|
begin
|
|
return Left + UR_From_Uint (Right);
|
|
end UR_Add;
|
|
|
|
function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
|
|
Lval : Ureal_Entry := Ureals.Table (Left);
|
|
Rval : Ureal_Entry := Ureals.Table (Right);
|
|
|
|
Num : Uint;
|
|
|
|
begin
|
|
-- Note, in the temporary Ureal_Entry values used in this procedure,
|
|
-- we store the sign as the sign of the numerator (i.e. xxx.Num may
|
|
-- be negative, even though in stored entries this can never be so)
|
|
|
|
if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
|
|
|
|
declare
|
|
Opd_Min, Opd_Max : Ureal_Entry;
|
|
Exp_Min, Exp_Max : Uint;
|
|
|
|
begin
|
|
if Lval.Negative then
|
|
Lval.Num := (-Lval.Num);
|
|
end if;
|
|
|
|
if Rval.Negative then
|
|
Rval.Num := (-Rval.Num);
|
|
end if;
|
|
|
|
if Lval.Den < Rval.Den then
|
|
Exp_Min := Lval.Den;
|
|
Exp_Max := Rval.Den;
|
|
Opd_Min := Lval;
|
|
Opd_Max := Rval;
|
|
else
|
|
Exp_Min := Rval.Den;
|
|
Exp_Max := Lval.Den;
|
|
Opd_Min := Rval;
|
|
Opd_Max := Lval;
|
|
end if;
|
|
|
|
Num :=
|
|
Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
|
|
|
|
if Num = 0 then
|
|
return Store_Ureal (
|
|
(Num => Uint_0,
|
|
Den => Uint_1,
|
|
Rbase => 0,
|
|
Negative => Lval.Negative));
|
|
|
|
else
|
|
return Store_Ureal (
|
|
(Num => abs Num,
|
|
Den => Exp_Max,
|
|
Rbase => Lval.Rbase,
|
|
Negative => (Num < 0)));
|
|
end if;
|
|
end;
|
|
|
|
else
|
|
declare
|
|
Ln : Ureal_Entry := Normalize (Lval);
|
|
Rn : Ureal_Entry := Normalize (Rval);
|
|
|
|
begin
|
|
if Ln.Negative then
|
|
Ln.Num := (-Ln.Num);
|
|
end if;
|
|
|
|
if Rn.Negative then
|
|
Rn.Num := (-Rn.Num);
|
|
end if;
|
|
|
|
Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
|
|
|
|
if Num = 0 then
|
|
return Store_Ureal (
|
|
(Num => Uint_0,
|
|
Den => Uint_1,
|
|
Rbase => 0,
|
|
Negative => Lval.Negative));
|
|
|
|
else
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => abs Num,
|
|
Den => Ln.Den * Rn.Den,
|
|
Rbase => 0,
|
|
Negative => (Num < 0))));
|
|
end if;
|
|
end;
|
|
end if;
|
|
end UR_Add;
|
|
|
|
----------------
|
|
-- UR_Ceiling --
|
|
----------------
|
|
|
|
function UR_Ceiling (Real : Ureal) return Uint is
|
|
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
|
begin
|
|
if Val.Negative then
|
|
return UI_Negate (Val.Num / Val.Den);
|
|
else
|
|
return (Val.Num + Val.Den - 1) / Val.Den;
|
|
end if;
|
|
end UR_Ceiling;
|
|
|
|
------------
|
|
-- UR_Div --
|
|
------------
|
|
|
|
function UR_Div (Left : Uint; Right : Ureal) return Ureal is
|
|
begin
|
|
return UR_From_Uint (Left) / Right;
|
|
end UR_Div;
|
|
|
|
function UR_Div (Left : Ureal; Right : Uint) return Ureal is
|
|
begin
|
|
return Left / UR_From_Uint (Right);
|
|
end UR_Div;
|
|
|
|
function UR_Div (Left, Right : Ureal) return Ureal is
|
|
Lval : constant Ureal_Entry := Ureals.Table (Left);
|
|
Rval : constant Ureal_Entry := Ureals.Table (Right);
|
|
Rneg : constant Boolean := Rval.Negative xor Lval.Negative;
|
|
|
|
begin
|
|
pragma Assert (Rval.Num /= Uint_0);
|
|
|
|
if Lval.Rbase = 0 then
|
|
|
|
if Rval.Rbase = 0 then
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Lval.Num * Rval.Den,
|
|
Den => Lval.Den * Rval.Num,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
|
|
elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
|
|
return Store_Ureal (
|
|
(Num => Lval.Num / (Rval.Num * Lval.Den),
|
|
Den => (-Rval.Den),
|
|
Rbase => Rval.Rbase,
|
|
Negative => Rneg));
|
|
|
|
elsif Rval.Den < 0 then
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Lval.Num,
|
|
Den => Rval.Rbase ** (-Rval.Den) *
|
|
Rval.Num *
|
|
Lval.Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
|
|
else
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Lval.Num * Rval.Rbase ** Rval.Den,
|
|
Den => Rval.Num * Lval.Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
end if;
|
|
|
|
elsif Is_Integer (Lval.Num, Rval.Num) then
|
|
|
|
if Rval.Rbase = Lval.Rbase then
|
|
return Store_Ureal (
|
|
(Num => Lval.Num / Rval.Num,
|
|
Den => Lval.Den - Rval.Den,
|
|
Rbase => Lval.Rbase,
|
|
Negative => Rneg));
|
|
|
|
elsif Rval.Rbase = 0 then
|
|
return Store_Ureal (
|
|
(Num => (Lval.Num / Rval.Num) * Rval.Den,
|
|
Den => Lval.Den,
|
|
Rbase => Lval.Rbase,
|
|
Negative => Rneg));
|
|
|
|
elsif Rval.Den < 0 then
|
|
declare
|
|
Num, Den : Uint;
|
|
|
|
begin
|
|
if Lval.Den < 0 then
|
|
Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
|
|
Den := Rval.Rbase ** (-Rval.Den);
|
|
else
|
|
Num := Lval.Num / Rval.Num;
|
|
Den := (Lval.Rbase ** Lval.Den) *
|
|
(Rval.Rbase ** (-Rval.Den));
|
|
end if;
|
|
|
|
return Store_Ureal (
|
|
(Num => Num,
|
|
Den => Den,
|
|
Rbase => 0,
|
|
Negative => Rneg));
|
|
end;
|
|
|
|
else
|
|
return Store_Ureal (
|
|
(Num => (Lval.Num / Rval.Num) *
|
|
(Rval.Rbase ** Rval.Den),
|
|
Den => Lval.Den,
|
|
Rbase => Lval.Rbase,
|
|
Negative => Rneg));
|
|
end if;
|
|
|
|
else
|
|
declare
|
|
Num, Den : Uint;
|
|
|
|
begin
|
|
if Lval.Den < 0 then
|
|
Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
|
|
Den := Rval.Num;
|
|
|
|
else
|
|
Num := Lval.Num;
|
|
Den := Rval.Num * (Lval.Rbase ** Lval.Den);
|
|
end if;
|
|
|
|
if Rval.Rbase /= 0 then
|
|
if Rval.Den < 0 then
|
|
Den := Den * (Rval.Rbase ** (-Rval.Den));
|
|
else
|
|
Num := Num * (Rval.Rbase ** Rval.Den);
|
|
end if;
|
|
|
|
else
|
|
Num := Num * Rval.Den;
|
|
end if;
|
|
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num,
|
|
Den => Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
end;
|
|
end if;
|
|
end UR_Div;
|
|
|
|
-----------
|
|
-- UR_Eq --
|
|
-----------
|
|
|
|
function UR_Eq (Left, Right : Ureal) return Boolean is
|
|
begin
|
|
return not UR_Ne (Left, Right);
|
|
end UR_Eq;
|
|
|
|
---------------------
|
|
-- UR_Exponentiate --
|
|
---------------------
|
|
|
|
function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
|
|
X : constant Uint := abs N;
|
|
Bas : Ureal;
|
|
Val : Ureal_Entry;
|
|
Neg : Boolean;
|
|
IBas : Uint;
|
|
|
|
begin
|
|
-- If base is negative, then the resulting sign depends on whether
|
|
-- the exponent is even or odd (even => positive, odd = negative)
|
|
|
|
if UR_Is_Negative (Real) then
|
|
Neg := (N mod 2) /= 0;
|
|
Bas := UR_Negate (Real);
|
|
else
|
|
Neg := False;
|
|
Bas := Real;
|
|
end if;
|
|
|
|
Val := Ureals.Table (Bas);
|
|
|
|
-- If the base is a small integer, then we can return the result in
|
|
-- exponential form, which can save a lot of time for junk exponents.
|
|
|
|
IBas := UR_Trunc (Bas);
|
|
|
|
if IBas <= 16
|
|
and then UR_From_Uint (IBas) = Bas
|
|
then
|
|
return Store_Ureal (
|
|
(Num => Uint_1,
|
|
Den => -N,
|
|
Rbase => UI_To_Int (UR_Trunc (Bas)),
|
|
Negative => Neg));
|
|
|
|
-- If the exponent is negative then we raise the numerator and the
|
|
-- denominator (after normalization) to the absolute value of the
|
|
-- exponent and we return the reciprocal. An assert error will happen
|
|
-- if the numerator is zero.
|
|
|
|
elsif N < 0 then
|
|
pragma Assert (Val.Num /= 0);
|
|
Val := Normalize (Val);
|
|
|
|
return Store_Ureal (
|
|
(Num => Val.Den ** X,
|
|
Den => Val.Num ** X,
|
|
Rbase => 0,
|
|
Negative => Neg));
|
|
|
|
-- If positive, we distinguish the case when the base is not zero, in
|
|
-- which case the new denominator is just the product of the old one
|
|
-- with the exponent,
|
|
|
|
else
|
|
if Val.Rbase /= 0 then
|
|
|
|
return Store_Ureal (
|
|
(Num => Val.Num ** X,
|
|
Den => Val.Den * X,
|
|
Rbase => Val.Rbase,
|
|
Negative => Neg));
|
|
|
|
-- And when the base is zero, in which case we exponentiate
|
|
-- the old denominator.
|
|
|
|
else
|
|
return Store_Ureal (
|
|
(Num => Val.Num ** X,
|
|
Den => Val.Den ** X,
|
|
Rbase => 0,
|
|
Negative => Neg));
|
|
end if;
|
|
end if;
|
|
end UR_Exponentiate;
|
|
|
|
--------------
|
|
-- UR_Floor --
|
|
--------------
|
|
|
|
function UR_Floor (Real : Ureal) return Uint is
|
|
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
|
begin
|
|
if Val.Negative then
|
|
return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
|
|
else
|
|
return Val.Num / Val.Den;
|
|
end if;
|
|
end UR_Floor;
|
|
|
|
------------------------
|
|
-- UR_From_Components --
|
|
------------------------
|
|
|
|
function UR_From_Components
|
|
(Num : Uint;
|
|
Den : Uint;
|
|
Rbase : Nat := 0;
|
|
Negative : Boolean := False)
|
|
return Ureal
|
|
is
|
|
begin
|
|
return Store_Ureal (
|
|
(Num => Num,
|
|
Den => Den,
|
|
Rbase => Rbase,
|
|
Negative => Negative));
|
|
end UR_From_Components;
|
|
|
|
------------------
|
|
-- UR_From_Uint --
|
|
------------------
|
|
|
|
function UR_From_Uint (UI : Uint) return Ureal is
|
|
begin
|
|
return UR_From_Components
|
|
(abs UI, Uint_1, Negative => (UI < 0));
|
|
end UR_From_Uint;
|
|
|
|
-----------
|
|
-- UR_Ge --
|
|
-----------
|
|
|
|
function UR_Ge (Left, Right : Ureal) return Boolean is
|
|
begin
|
|
return not (Left < Right);
|
|
end UR_Ge;
|
|
|
|
-----------
|
|
-- UR_Gt --
|
|
-----------
|
|
|
|
function UR_Gt (Left, Right : Ureal) return Boolean is
|
|
begin
|
|
return (Right < Left);
|
|
end UR_Gt;
|
|
|
|
--------------------
|
|
-- UR_Is_Negative --
|
|
--------------------
|
|
|
|
function UR_Is_Negative (Real : Ureal) return Boolean is
|
|
begin
|
|
return Ureals.Table (Real).Negative;
|
|
end UR_Is_Negative;
|
|
|
|
--------------------
|
|
-- UR_Is_Positive --
|
|
--------------------
|
|
|
|
function UR_Is_Positive (Real : Ureal) return Boolean is
|
|
begin
|
|
return not Ureals.Table (Real).Negative
|
|
and then Ureals.Table (Real).Num /= 0;
|
|
end UR_Is_Positive;
|
|
|
|
----------------
|
|
-- UR_Is_Zero --
|
|
----------------
|
|
|
|
function UR_Is_Zero (Real : Ureal) return Boolean is
|
|
begin
|
|
return Ureals.Table (Real).Num = 0;
|
|
end UR_Is_Zero;
|
|
|
|
-----------
|
|
-- UR_Le --
|
|
-----------
|
|
|
|
function UR_Le (Left, Right : Ureal) return Boolean is
|
|
begin
|
|
return not (Right < Left);
|
|
end UR_Le;
|
|
|
|
-----------
|
|
-- UR_Lt --
|
|
-----------
|
|
|
|
function UR_Lt (Left, Right : Ureal) return Boolean is
|
|
begin
|
|
-- An operand is not less than itself
|
|
|
|
if Same (Left, Right) then
|
|
return False;
|
|
|
|
-- Deal with zero cases
|
|
|
|
elsif UR_Is_Zero (Left) then
|
|
return UR_Is_Positive (Right);
|
|
|
|
elsif UR_Is_Zero (Right) then
|
|
return Ureals.Table (Left).Negative;
|
|
|
|
-- Different signs are decisive (note we dealt with zero cases)
|
|
|
|
elsif Ureals.Table (Left).Negative
|
|
and then not Ureals.Table (Right).Negative
|
|
then
|
|
return True;
|
|
|
|
elsif not Ureals.Table (Left).Negative
|
|
and then Ureals.Table (Right).Negative
|
|
then
|
|
return False;
|
|
|
|
-- Signs are same, do rapid check based on worst case estimates of
|
|
-- decimal exponent, which will often be decisive. Precise test
|
|
-- depends on whether operands are positive or negative.
|
|
|
|
elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
|
|
return UR_Is_Positive (Left);
|
|
|
|
elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
|
|
return UR_Is_Negative (Left);
|
|
|
|
-- If we fall through, full gruesome test is required. This happens
|
|
-- if the numbers are close together, or in some weird (/=10) base.
|
|
|
|
else
|
|
declare
|
|
Imrk : constant Uintp.Save_Mark := Mark;
|
|
Rmrk : constant Urealp.Save_Mark := Mark;
|
|
Lval : Ureal_Entry;
|
|
Rval : Ureal_Entry;
|
|
Result : Boolean;
|
|
|
|
begin
|
|
Lval := Ureals.Table (Left);
|
|
Rval := Ureals.Table (Right);
|
|
|
|
-- An optimization. If both numbers are based, then subtract
|
|
-- common value of base to avoid unnecessarily giant numbers
|
|
|
|
if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
|
|
if Lval.Den < Rval.Den then
|
|
Rval.Den := Rval.Den - Lval.Den;
|
|
Lval.Den := Uint_0;
|
|
else
|
|
Lval.Den := Lval.Den - Rval.Den;
|
|
Rval.Den := Uint_0;
|
|
end if;
|
|
end if;
|
|
|
|
Lval := Normalize (Lval);
|
|
Rval := Normalize (Rval);
|
|
|
|
if Lval.Negative then
|
|
Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
|
|
else
|
|
Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
|
|
end if;
|
|
|
|
Release (Imrk);
|
|
Release (Rmrk);
|
|
return Result;
|
|
end;
|
|
end if;
|
|
end UR_Lt;
|
|
|
|
------------
|
|
-- UR_Max --
|
|
------------
|
|
|
|
function UR_Max (Left, Right : Ureal) return Ureal is
|
|
begin
|
|
if Left >= Right then
|
|
return Left;
|
|
else
|
|
return Right;
|
|
end if;
|
|
end UR_Max;
|
|
|
|
------------
|
|
-- UR_Min --
|
|
------------
|
|
|
|
function UR_Min (Left, Right : Ureal) return Ureal is
|
|
begin
|
|
if Left <= Right then
|
|
return Left;
|
|
else
|
|
return Right;
|
|
end if;
|
|
end UR_Min;
|
|
|
|
------------
|
|
-- UR_Mul --
|
|
------------
|
|
|
|
function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
|
|
begin
|
|
return UR_From_Uint (Left) * Right;
|
|
end UR_Mul;
|
|
|
|
function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
|
|
begin
|
|
return Left * UR_From_Uint (Right);
|
|
end UR_Mul;
|
|
|
|
function UR_Mul (Left, Right : Ureal) return Ureal is
|
|
Lval : constant Ureal_Entry := Ureals.Table (Left);
|
|
Rval : constant Ureal_Entry := Ureals.Table (Right);
|
|
Num : Uint := Lval.Num * Rval.Num;
|
|
Den : Uint;
|
|
Rneg : constant Boolean := Lval.Negative xor Rval.Negative;
|
|
|
|
begin
|
|
if Lval.Rbase = 0 then
|
|
if Rval.Rbase = 0 then
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num,
|
|
Den => Lval.Den * Rval.Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
|
|
elsif Is_Integer (Num, Lval.Den) then
|
|
return Store_Ureal (
|
|
(Num => Num / Lval.Den,
|
|
Den => Rval.Den,
|
|
Rbase => Rval.Rbase,
|
|
Negative => Rneg));
|
|
|
|
elsif Rval.Den < 0 then
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num * (Rval.Rbase ** (-Rval.Den)),
|
|
Den => Lval.Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
|
|
else
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num,
|
|
Den => Lval.Den * (Rval.Rbase ** Rval.Den),
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
end if;
|
|
|
|
elsif Lval.Rbase = Rval.Rbase then
|
|
return Store_Ureal (
|
|
(Num => Num,
|
|
Den => Lval.Den + Rval.Den,
|
|
Rbase => Lval.Rbase,
|
|
Negative => Rneg));
|
|
|
|
elsif Rval.Rbase = 0 then
|
|
if Is_Integer (Num, Rval.Den) then
|
|
return Store_Ureal (
|
|
(Num => Num / Rval.Den,
|
|
Den => Lval.Den,
|
|
Rbase => Lval.Rbase,
|
|
Negative => Rneg));
|
|
|
|
elsif Lval.Den < 0 then
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num * (Lval.Rbase ** (-Lval.Den)),
|
|
Den => Rval.Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
|
|
else
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num,
|
|
Den => Rval.Den * (Lval.Rbase ** Lval.Den),
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
end if;
|
|
|
|
else
|
|
Den := Uint_1;
|
|
|
|
if Lval.Den < 0 then
|
|
Num := Num * (Lval.Rbase ** (-Lval.Den));
|
|
else
|
|
Den := Den * (Lval.Rbase ** Lval.Den);
|
|
end if;
|
|
|
|
if Rval.Den < 0 then
|
|
Num := Num * (Rval.Rbase ** (-Rval.Den));
|
|
else
|
|
Den := Den * (Rval.Rbase ** Rval.Den);
|
|
end if;
|
|
|
|
return Store_Ureal (
|
|
Normalize (
|
|
(Num => Num,
|
|
Den => Den,
|
|
Rbase => 0,
|
|
Negative => Rneg)));
|
|
end if;
|
|
end UR_Mul;
|
|
|
|
-----------
|
|
-- UR_Ne --
|
|
-----------
|
|
|
|
function UR_Ne (Left, Right : Ureal) return Boolean is
|
|
begin
|
|
-- Quick processing for case of identical Ureal values (note that
|
|
-- this also deals with comparing two No_Ureal values).
|
|
|
|
if Same (Left, Right) then
|
|
return False;
|
|
|
|
-- Deal with case of one or other operand is No_Ureal, but not both
|
|
|
|
elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
|
|
return True;
|
|
|
|
-- Do quick check based on number of decimal digits
|
|
|
|
elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
|
|
Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
|
|
then
|
|
return True;
|
|
|
|
-- Otherwise full comparison is required
|
|
|
|
else
|
|
declare
|
|
Imrk : constant Uintp.Save_Mark := Mark;
|
|
Rmrk : constant Urealp.Save_Mark := Mark;
|
|
Lval : constant Ureal_Entry := Normalize (Ureals.Table (Left));
|
|
Rval : constant Ureal_Entry := Normalize (Ureals.Table (Right));
|
|
Result : Boolean;
|
|
|
|
begin
|
|
if UR_Is_Zero (Left) then
|
|
return not UR_Is_Zero (Right);
|
|
|
|
elsif UR_Is_Zero (Right) then
|
|
return not UR_Is_Zero (Left);
|
|
|
|
-- Both operands are non-zero
|
|
|
|
else
|
|
Result :=
|
|
Rval.Negative /= Lval.Negative
|
|
or else Rval.Num /= Lval.Num
|
|
or else Rval.Den /= Lval.Den;
|
|
Release (Imrk);
|
|
Release (Rmrk);
|
|
return Result;
|
|
end if;
|
|
end;
|
|
end if;
|
|
end UR_Ne;
|
|
|
|
---------------
|
|
-- UR_Negate --
|
|
---------------
|
|
|
|
function UR_Negate (Real : Ureal) return Ureal is
|
|
begin
|
|
return Store_Ureal (
|
|
(Num => Ureals.Table (Real).Num,
|
|
Den => Ureals.Table (Real).Den,
|
|
Rbase => Ureals.Table (Real).Rbase,
|
|
Negative => not Ureals.Table (Real).Negative));
|
|
end UR_Negate;
|
|
|
|
------------
|
|
-- UR_Sub --
|
|
------------
|
|
|
|
function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
|
|
begin
|
|
return UR_From_Uint (Left) + UR_Negate (Right);
|
|
end UR_Sub;
|
|
|
|
function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
|
|
begin
|
|
return Left + UR_From_Uint (-Right);
|
|
end UR_Sub;
|
|
|
|
function UR_Sub (Left, Right : Ureal) return Ureal is
|
|
begin
|
|
return Left + UR_Negate (Right);
|
|
end UR_Sub;
|
|
|
|
----------------
|
|
-- UR_To_Uint --
|
|
----------------
|
|
|
|
function UR_To_Uint (Real : Ureal) return Uint is
|
|
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
Res : Uint;
|
|
|
|
begin
|
|
Res := (Val.Num + (Val.Den / 2)) / Val.Den;
|
|
|
|
if Val.Negative then
|
|
return UI_Negate (Res);
|
|
else
|
|
return Res;
|
|
end if;
|
|
end UR_To_Uint;
|
|
|
|
--------------
|
|
-- UR_Trunc --
|
|
--------------
|
|
|
|
function UR_Trunc (Real : Ureal) return Uint is
|
|
Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
|
|
|
|
begin
|
|
if Val.Negative then
|
|
return -(Val.Num / Val.Den);
|
|
else
|
|
return Val.Num / Val.Den;
|
|
end if;
|
|
end UR_Trunc;
|
|
|
|
--------------
|
|
-- UR_Write --
|
|
--------------
|
|
|
|
procedure UR_Write (Real : Ureal) is
|
|
Val : constant Ureal_Entry := Ureals.Table (Real);
|
|
|
|
begin
|
|
-- If value is negative, we precede the constant by a minus sign
|
|
-- and add an extra layer of parentheses on the outside since the
|
|
-- minus sign is part of the value, not a negation operator.
|
|
|
|
if Val.Negative then
|
|
Write_Str ("(-");
|
|
end if;
|
|
|
|
-- Constants in base 10 can be written in normal Ada literal style
|
|
|
|
if Val.Rbase = 10 then
|
|
UI_Write (Val.Num / 10);
|
|
Write_Char ('.');
|
|
UI_Write (Val.Num mod 10);
|
|
|
|
if Val.Den /= 0 then
|
|
Write_Char ('E');
|
|
UI_Write (1 - Val.Den);
|
|
end if;
|
|
|
|
-- Constants in a base other than 10 can still be easily written
|
|
-- in normal Ada literal style if the numerator is one.
|
|
|
|
elsif Val.Rbase /= 0 and then Val.Num = 1 then
|
|
Write_Int (Val.Rbase);
|
|
Write_Str ("#1.0#E");
|
|
UI_Write (-Val.Den);
|
|
|
|
-- Other constants with a base other than 10 are written using one
|
|
-- of the following forms, depending on the sign of the number
|
|
-- and the sign of the exponent (= minus denominator value)
|
|
|
|
-- (numerator.0*base**exponent)
|
|
-- (numerator.0*base**(-exponent))
|
|
|
|
elsif Val.Rbase /= 0 then
|
|
Write_Char ('(');
|
|
UI_Write (Val.Num, Decimal);
|
|
Write_Str (".0*");
|
|
Write_Int (Val.Rbase);
|
|
Write_Str ("**");
|
|
|
|
if Val.Den <= 0 then
|
|
UI_Write (-Val.Den, Decimal);
|
|
|
|
else
|
|
Write_Str ("(-");
|
|
UI_Write (Val.Den, Decimal);
|
|
Write_Char (')');
|
|
end if;
|
|
|
|
Write_Char (')');
|
|
|
|
-- Rational constants with a denominator of 1 can be written as
|
|
-- a real literal for the numerator integer.
|
|
|
|
elsif Val.Den = 1 then
|
|
UI_Write (Val.Num, Decimal);
|
|
Write_Str (".0");
|
|
|
|
-- Non-based (rational) constants are written in (num/den) style
|
|
|
|
else
|
|
Write_Char ('(');
|
|
UI_Write (Val.Num, Decimal);
|
|
Write_Str (".0/");
|
|
UI_Write (Val.Den, Decimal);
|
|
Write_Str (".0)");
|
|
end if;
|
|
|
|
-- Add trailing paren for negative values
|
|
|
|
if Val.Negative then
|
|
Write_Char (')');
|
|
end if;
|
|
end UR_Write;
|
|
|
|
-------------
|
|
-- Ureal_0 --
|
|
-------------
|
|
|
|
function Ureal_0 return Ureal is
|
|
begin
|
|
return UR_0;
|
|
end Ureal_0;
|
|
|
|
-------------
|
|
-- Ureal_1 --
|
|
-------------
|
|
|
|
function Ureal_1 return Ureal is
|
|
begin
|
|
return UR_1;
|
|
end Ureal_1;
|
|
|
|
-------------
|
|
-- Ureal_2 --
|
|
-------------
|
|
|
|
function Ureal_2 return Ureal is
|
|
begin
|
|
return UR_2;
|
|
end Ureal_2;
|
|
|
|
--------------
|
|
-- Ureal_10 --
|
|
--------------
|
|
|
|
function Ureal_10 return Ureal is
|
|
begin
|
|
return UR_10;
|
|
end Ureal_10;
|
|
|
|
---------------
|
|
-- Ureal_100 --
|
|
---------------
|
|
|
|
function Ureal_100 return Ureal is
|
|
begin
|
|
return UR_100;
|
|
end Ureal_100;
|
|
|
|
-----------------
|
|
-- Ureal_10_36 --
|
|
-----------------
|
|
|
|
function Ureal_10_36 return Ureal is
|
|
begin
|
|
return UR_10_36;
|
|
end Ureal_10_36;
|
|
|
|
----------------
|
|
-- Ureal_2_80 --
|
|
----------------
|
|
|
|
function Ureal_2_80 return Ureal is
|
|
begin
|
|
return UR_2_80;
|
|
end Ureal_2_80;
|
|
|
|
-----------------
|
|
-- Ureal_2_128 --
|
|
-----------------
|
|
|
|
function Ureal_2_128 return Ureal is
|
|
begin
|
|
return UR_2_128;
|
|
end Ureal_2_128;
|
|
|
|
-------------------
|
|
-- Ureal_2_M_80 --
|
|
-------------------
|
|
|
|
function Ureal_2_M_80 return Ureal is
|
|
begin
|
|
return UR_2_M_80;
|
|
end Ureal_2_M_80;
|
|
|
|
-------------------
|
|
-- Ureal_2_M_128 --
|
|
-------------------
|
|
|
|
function Ureal_2_M_128 return Ureal is
|
|
begin
|
|
return UR_2_M_128;
|
|
end Ureal_2_M_128;
|
|
|
|
----------------
|
|
-- Ureal_Half --
|
|
----------------
|
|
|
|
function Ureal_Half return Ureal is
|
|
begin
|
|
return UR_Half;
|
|
end Ureal_Half;
|
|
|
|
---------------
|
|
-- Ureal_M_0 --
|
|
---------------
|
|
|
|
function Ureal_M_0 return Ureal is
|
|
begin
|
|
return UR_M_0;
|
|
end Ureal_M_0;
|
|
|
|
-------------------
|
|
-- Ureal_M_10_36 --
|
|
-------------------
|
|
|
|
function Ureal_M_10_36 return Ureal is
|
|
begin
|
|
return UR_M_10_36;
|
|
end Ureal_M_10_36;
|
|
|
|
-----------------
|
|
-- Ureal_Tenth --
|
|
-----------------
|
|
|
|
function Ureal_Tenth return Ureal is
|
|
begin
|
|
return UR_Tenth;
|
|
end Ureal_Tenth;
|
|
|
|
end Urealp;
|