Make-lang.in: Remove ttypef.ads

2010-10-22  Geert Bosch  <bosch@adacore.com>

	* gcc-interface/Make-lang.in: Remove ttypef.ads
	* checks.adb: Use Machine_Mantissa_Value and Machine_Radix_Value instead
	of Machine_Mantissa and Machine_Radix.
	* cstand.adb (P_Float_Range): Directly print the Type_Low_Bound and
	Type_High_Bound of the type, instead of choosing constants from Ttypef.
	(Set_Float_Bounds): Compute the bounds based on Machine_Radix_Value,
	Machine_Emax_Value and Machine_Mantissa_Value instead of special-casing
	each type.
	* einfo.ads (Machine_Emax_Value, Machine_Emin_Value,
	Machine_Mantissa_Value, Machine_Radix_Value, Model_Emin_Value,
	Model_Epsilon_Value, Model_Mantissa_Value, Model_Small_Value,
	Safe_Emax_Value, Safe_First_Value, Safe_Last_Value): Add new
	synthesized floating point attributes.
	* einfo.adb (Float_Rep): Determine the kind of floating point
	representation used for a given type.
	(Machine_Emax_Value, Machine_Emin_Value, Machine_Mantissa_Value,
	Machine_Radix_Value): Implement based on Float_Rep_Kind of a type and
	the number of digits in the type.
	(Model_Emin_Value, Model_Epsilon_Value, Model_Mantissa_Value,
	Model_Small_Value, Safe_Emax_Value, Safe_First_Value, Safe_Last_Value):
	Implement new synthesized floating point attributes based on the various
	machine attributes.
	* eval_fat.ads: Remove Machine_Mantissa and Machine_Radix.
	* eval_fat.adb (Machine_Mantissa, Machine_Radix): Remove. Use the
	Machine_Mantissa_Value and Machine_Radix_Value functions instead.
	* exp_vfpt.adb (VAXFF_Digits, VAXDF_Digits, VAXFG_Digits): Define local
	constants, instead of using constants from Ttypef.
	* gnat_rm.texi: Reword comments referencing Ttypef.
	* sem_attr.ads: Reword comment referencing Ttypef.
	* sem_attr.adb (Float_Attribute_Universal_Integer,
	Float_Attribute_Universal_Real): Remove.
	(Attribute_Machine_Emax, Attribute_Machine_Emin,
	Attribute_Machine_Mantissa, Attribute_Model_Epsilon,
	Attribute_Model_Mantissa, Attribute_Model_Small, Attribute_Safe_Emax,
	Attribute_Safe_First, Attribute_Safe_Last, Model_Small_Value): Use
	attributes in Einfo instead of Float_Attribute_Universal_Real and
	Float_Attribute_Universal_Integer and all explicit constants.
	* sem_util.ads, sem_util.adb (Real_Convert): Remove.
	* sem_vfpt.adb (VAXDF_Digits, VAXFF_Digits, VAXGF_Digits, IEEEL_Digits,
	IEEES_Digits): New local constants, in order to remove dependency on
	Ttypef.
	* tbuild.ads (Make_Float_Literal): New function.
	* tbuild.adb (Make_Float_Literal): New function to create a new
	N_Real_Literal, constructing it as simple as possible for best
	output of constants in -gnatS.
	* ttypef.ads: Remove.

From-SVN: r165808

1 files changed, 157 insertions, 6 deletions

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 68eedfd..ad5eba9 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -32,11 +32,12 @@
 pragma Style_Checks (All_Checks);
 --  Turn off subprogram ordering, not used for this unit
 
-with Atree;  use Atree;
-with Nlists; use Nlists;
-with Output; use Output;
-with Sinfo;  use Sinfo;
-with Stand;  use Stand;
+with Atree;    use Atree;
+with Nlists;   use Nlists;
+with Output;   use Output;
+with Sinfo;    use Sinfo;
+with Stand;    use Stand;
+with Targparm; use Targparm;
 
 package body Einfo is
 
@@ -520,6 +521,12 @@ package body Einfo is
    --    (unused)                        Flag253
    --    (unused)                        Flag254
 
+   -----------------
+   -- Local types --
+   -----------------
+
+   type Float_Rep_Kind is (IEEE_Binary, VAX_Native, AAMP);
+
    -----------------------
    -- Local subprograms --
    -----------------------
@@ -528,6 +535,25 @@ package body Einfo is
    --  Returns the attribute definition clause for Id whose name is Rep_Name.
    --  Returns Empty if no matching attribute definition clause found for Id.
 
+   function Float_Rep (Id : E) return Float_Rep_Kind;
+   --  Returns the floating point representation used for the given type
+
+   ---------------
+   -- Float_Rep --
+   ---------------
+
+   function Float_Rep (Id : E) return Float_Rep_Kind is
+      pragma Assert (Is_Floating_Point_Type (Id));
+   begin
+      if AAMP_On_Target then
+         return AAMP;
+      elsif Vax_Float (Id) then
+         return VAX_Native;
+      else
+         return IEEE_Binary;
+      end if;
+   end Float_Rep;
+
    ----------------
    -- Rep_Clause --
    ----------------
@@ -2185,12 +2211,84 @@ package body Einfo is
       return Flag205 (Id);
    end Low_Bound_Tested;
 
+   function Machine_Emax_Value (Id : E) return Uint is
+      Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
+
+   begin
+      case Float_Rep (Id) is
+         when IEEE_Binary =>
+            case Digs is
+               when  1 ..  6 => return Uint_128;
+               when  7 .. 15 => return 2**10;
+               when 16 .. 18 => return 2**14;
+               when others => return No_Uint;
+            end case;
+
+         when VAX_Native =>
+            case Digs is
+               when  1 ..  9 => return 2**7 - 1;
+               when 10 .. 15 => return 2**10 - 1;
+               when others => return No_Uint;
+            end case;
+
+         when AAMP =>
+            return Uint_2 ** Uint_7 - Uint_1;
+      end case;
+   end Machine_Emax_Value;
+
+   function Machine_Emin_Value (Id : E) return Uint is
+   begin
+      case Float_Rep (Id) is
+         when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
+         when VAX_Native  => return -Machine_Emax_Value (Id);
+         when AAMP        => return -Machine_Emax_Value (Id);
+      end case;
+   end Machine_Emin_Value;
+
+   function Machine_Mantissa_Value (Id : E) return Uint is
+      Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
+
+   begin
+      case Float_Rep (Id) is
+         when IEEE_Binary =>
+            case Digs is
+               when  1 ..  6 => return Uint_24;
+               when  7 .. 15 => return UI_From_Int (53);
+               when 16 .. 18 => return Uint_64;
+               when others => return No_Uint;
+            end case;
+
+         when VAX_Native =>
+            case Digs is
+               when  1 ..  6 => return Uint_24;
+               when  7 ..  9 => return UI_From_Int (56);
+               when 10 .. 15 => return UI_From_Int (53);
+               when others => return No_Uint;
+            end case;
+
+         when AAMP =>
+            case Digs is
+               when  1 ..  6 => return Uint_24;
+               when  7 ..  9 => return UI_From_Int (40);
+               when others => return No_Uint;
+            end case;
+      end case;
+   end Machine_Mantissa_Value;
+
    function Machine_Radix_10 (Id : E) return B is
    begin
       pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
       return Flag84 (Id);
    end Machine_Radix_10;
 
+   function Machine_Radix_Value (Id : E) return U is
+   begin
+      case Float_Rep (Id) is
+         when IEEE_Binary | VAX_Native | AAMP =>
+            return Uint_2;
+      end case;
+   end Machine_Radix_Value;
+
    function Master_Id (Id : E) return E is
    begin
       pragma Assert (Is_Access_Type (Id));
@@ -2208,6 +2306,28 @@ package body Einfo is
       return UI_To_Int (Uint8 (Id));
    end Mechanism;
 
+   function Model_Emin_Value (Id : E) return Uint is
+   begin
+      return Machine_Emin_Value (Id);
+   end Model_Emin_Value;
+
+   function Model_Epsilon_Value (Id : E) return Ureal is
+      Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
+   begin
+      return Radix ** (1 - Model_Mantissa_Value (Id));
+   end Model_Epsilon_Value;
+
+   function Model_Mantissa_Value (Id : E) return Uint is
+   begin
+      return Machine_Mantissa_Value (Id);
+   end Model_Mantissa_Value;
+
+   function Model_Small_Value (Id : E) return Ureal is
+      Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
+   begin
+      return Radix ** (Model_Emin_Value (Id) - 1);
+   end Model_Small_Value;
+
    function Modulus (Id : E) return Uint is
    begin
       pragma Assert (Is_Modular_Integer_Type (Id));
@@ -2540,6 +2660,38 @@ package body Einfo is
       return Uint13 (Id);
    end RM_Size;
 
+   function Safe_Emax_Value (Id : E) return Uint is
+   begin
+      return Machine_Emax_Value (Id);
+   end Safe_Emax_Value;
+
+   function Safe_First_Value (Id : E) return Ureal is
+   begin
+      return -Safe_Last_Value (Id);
+   end Safe_First_Value;
+
+   function Safe_Last_Value (Id : E) return Ureal is
+      Radix       : constant Uint := Machine_Radix_Value (Id);
+      Mantissa    : constant Uint := Machine_Mantissa_Value (Id);
+      Emax        : constant Uint := Safe_Emax_Value (Id);
+      Significand : constant Uint := Radix ** Mantissa - 1;
+      Exponent    : constant Uint := Emax - Mantissa;
+   begin
+      if Radix = 2 then
+         return
+           UR_From_Components
+             (Num   => Significand * 2 ** (Exponent mod 4),
+              Den   => -Exponent / 4,
+              Rbase => 16);
+      else
+         return
+           UR_From_Components
+             (Num => Significand,
+              Den => -Exponent,
+              Rbase => 16);
+      end if;
+   end Safe_Last_Value;
+
    function Scalar_Range (Id : E) return N is
    begin
       return Node20 (Id);
@@ -6549,7 +6701,6 @@ package body Einfo is
       --  of analyzing default expressions.
 
       P := Id;
-
       loop
          P := Next_Entity (P);