-- --
-- B o d y --
-- --
--- $Revision: 1.1 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
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,
+ Table_Index_Type => Ureal'Base,
Table_Low_Bound => Ureal_First_Entry,
Table_Initial => Alloc.Ureals_Initial,
Table_Increment => Alloc.Ureals_Increment,
-- The following universal reals are the values returned by the constant
-- functions. They are initialized by the initialization procedure.
- UR_M_0 : Ureal;
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
return UI_Decimal_Digits_Hi (Val.Num) -
Equivalent_Decimal_Exponent (Val) + 1;
end if;
-
end Decimal_Exponent_Hi;
-------------------------
return UI_Decimal_Digits_Lo (Val.Num) -
Equivalent_Decimal_Exponent (Val) - 1;
end if;
-
end Decimal_Exponent_Lo;
-----------------
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;
----------------
----------------
function UR_Ceiling (Real : Ureal) return Uint is
- Val : Ureal_Entry := Normalize (Ureals.Table (Real));
+ Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
begin
if Val.Negative then
---------------------
function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
+ X : constant Uint := abs N;
Bas : Ureal;
Val : Ureal_Entry;
- X : Uint := abs N;
Neg : Boolean;
IBas : Uint;
--------------
function UR_Floor (Real : Ureal) return Uint is
- Val : Ureal_Entry := Normalize (Ureals.Table (Real));
+ Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
begin
if Val.Negative then
end if;
end UR_Floor;
- -------------------------
- -- UR_From_Components --
- -------------------------
+ ------------------------
+ -- UR_From_Components --
+ ------------------------
function UR_From_Components
(Num : Uint;
Rbase => 0,
Negative => Rneg)));
end if;
-
end UR_Mul;
-----------
----------------
function UR_To_Uint (Real : Ureal) return Uint is
- Val : Ureal_Entry := Normalize (Ureals.Table (Real));
+ Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
Res : Uint;
begin
end if;
-- Constants in base 10 can be written in normal Ada literal style
- -- If the literal is negative enclose in parens to emphasize that
- -- it is part of the constant, and not a separate negation operator
if Val.Rbase = 10 then
-
UI_Write (Val.Num / 10);
Write_Char ('.');
UI_Write (Val.Num mod 10);
if Val.Negative then
Write_Char (')');
end if;
-
end UR_Write;
-------------
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 --
-----------------
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 --
-------------------
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 --
-----------------
OSDN Git Service
