2010-10-22 Geert Bosch <bosch@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 22 Oct 2010 09:28:24 +0000 (09:28 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 22 Oct 2010 09:28:24 +0000 (09:28 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165808 138bc75d-0d04-0410-961f-82ee72b054a4

18 files changed:
gcc/ada/ChangeLog
gcc/ada/checks.adb
gcc/ada/cstand.adb
gcc/ada/einfo.adb
gcc/ada/einfo.ads
gcc/ada/eval_fat.adb
gcc/ada/eval_fat.ads
gcc/ada/exp_vfpt.adb
gcc/ada/gcc-interface/Make-lang.in
gcc/ada/gnat_rm.texi
gcc/ada/sem_attr.adb
gcc/ada/sem_attr.ads
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads
gcc/ada/sem_vfpt.adb
gcc/ada/tbuild.adb
gcc/ada/tbuild.ads
gcc/ada/ttypef.ads [deleted file]

index ff1fba1..0dd91b9 100644 (file)
@@ -1,3 +1,52 @@
+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.
+
 2010-10-22  Robert Dewar  <dewar@adacore.com>
 
        * checks.adb (Apply_Predicate_Check): Remove attempt at optimization
index 17b9fcb..234317f 100644 (file)
@@ -1564,8 +1564,8 @@ package body Checks is
       Truncate  : constant Boolean := Float_Truncate (Par);
       Max_Bound : constant Uint :=
                     UI_Expon
-                      (Machine_Radix (Expr_Type),
-                       Machine_Mantissa (Expr_Type) - 1) - 1;
+                      (Machine_Radix_Value (Expr_Type),
+                       Machine_Mantissa_Value (Expr_Type) - 1) - 1;
 
       --  Largest bound, so bound plus or minus half is a machine number of F
 
index bc85f0c..db1034f 100644 (file)
@@ -36,7 +36,6 @@ with Output;   use Output;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Ttypes;   use Ttypes;
-with Ttypef;   use Ttypef;
 with Scn;
 with Sem_Mech; use Sem_Mech;
 with Sem_Util; use Sem_Util;
@@ -1670,61 +1669,11 @@ package body CStand is
       -------------------
 
       procedure P_Float_Range (Id : Entity_Id) is
-         Digs : constant Nat := UI_To_Int (Digits_Value (Id));
-
       begin
          Write_Str ("     range ");
-
-         if Vax_Float (Id) then
-            if Digs = VAXFF_Digits then
-               Write_Str (VAXFF_First'Universal_Literal_String);
-               Write_Str (" .. ");
-               Write_Str (VAXFF_Last'Universal_Literal_String);
-
-            elsif Digs = VAXDF_Digits then
-               Write_Str (VAXDF_First'Universal_Literal_String);
-               Write_Str (" .. ");
-               Write_Str (VAXDF_Last'Universal_Literal_String);
-
-            else
-               pragma Assert (Digs = VAXGF_Digits);
-
-               Write_Str (VAXGF_First'Universal_Literal_String);
-               Write_Str (" .. ");
-               Write_Str (VAXGF_Last'Universal_Literal_String);
-            end if;
-
-         elsif Is_AAMP_Float (Id) then
-            if Digs = AAMPS_Digits then
-               Write_Str (AAMPS_First'Universal_Literal_String);
-               Write_Str (" .. ");
-               Write_Str (AAMPS_Last'Universal_Literal_String);
-
-            else
-               pragma Assert (Digs = AAMPL_Digits);
-               Write_Str (AAMPL_First'Universal_Literal_String);
-               Write_Str (" .. ");
-               Write_Str (AAMPL_Last'Universal_Literal_String);
-            end if;
-
-         elsif Digs = IEEES_Digits then
-            Write_Str (IEEES_First'Universal_Literal_String);
-            Write_Str (" .. ");
-            Write_Str (IEEES_Last'Universal_Literal_String);
-
-         elsif Digs = IEEEL_Digits then
-            Write_Str (IEEEL_First'Universal_Literal_String);
-            Write_Str (" .. ");
-            Write_Str (IEEEL_Last'Universal_Literal_String);
-
-         else
-            pragma Assert (Digs = IEEEX_Digits);
-
-            Write_Str (IEEEX_First'Universal_Literal_String);
-            Write_Str (" .. ");
-            Write_Str (IEEEX_Last'Universal_Literal_String);
-         end if;
-
+         UR_Write (Realval (Type_Low_Bound (Id)));
+         Write_Str (" .. ");
+         UR_Write (Realval (Type_High_Bound (Id)));
          Write_Str (";");
          Write_Eol;
       end P_Float_Range;
@@ -1908,81 +1857,29 @@ package body CStand is
    ----------------------
 
    procedure Set_Float_Bounds (Id  : Entity_Id) is
-      L  : Node_Id;
+      L : Node_Id;
       --  Low bound of literal value
 
-      H  : Node_Id;
+      H : Node_Id;
       --  High bound of literal value
 
-      R  : Node_Id;
+      R : Node_Id;
       --  Range specification
 
-      Digs  : constant Nat := UI_To_Int (Digits_Value (Id));
-      --  Digits value, used to select bounds
+      Radix       : constant Uint := Machine_Radix_Value (Id);
+      Mantissa    : constant Uint := Machine_Mantissa_Value (Id);
+      Emax        : constant Uint := Machine_Emax_Value (Id);
+      Significand : constant Uint := Radix ** Mantissa - 1;
+      Exponent    : constant Uint := Emax - Mantissa;
 
    begin
       --  Note: for the call from Cstand to initially create the types in
       --  Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
-      --  will adjust these types appropriately in the Vax_Float case if
-      --  a pragma Float_Representation (VAX_Float) is used.
-
-      if Vax_Float (Id) then
-         if Digs = VAXFF_Digits then
-            L := Real_Convert
-                   (VAXFF_First'Universal_Literal_String);
-            H := Real_Convert
-                   (VAXFF_Last'Universal_Literal_String);
-
-         elsif Digs = VAXDF_Digits then
-            L := Real_Convert
-                   (VAXDF_First'Universal_Literal_String);
-            H := Real_Convert
-                   (VAXDF_Last'Universal_Literal_String);
-
-         else
-            pragma Assert (Digs = VAXGF_Digits);
-
-            L := Real_Convert
-                   (VAXGF_First'Universal_Literal_String);
-            H := Real_Convert
-                   (VAXGF_Last'Universal_Literal_String);
-         end if;
-
-      elsif Is_AAMP_Float (Id) then
-         if Digs = AAMPS_Digits then
-            L := Real_Convert
-                   (AAMPS_First'Universal_Literal_String);
-            H := Real_Convert
-                   (AAMPS_Last'Universal_Literal_String);
-
-         else
-            pragma Assert (Digs = AAMPL_Digits);
-            L := Real_Convert
-                   (AAMPL_First'Universal_Literal_String);
-            H := Real_Convert
-                   (AAMPL_Last'Universal_Literal_String);
-         end if;
+      --  will adjust these types appropriately in the Vax_Float case if a
+      --  pragma Float_Representation (VAX_Float) is used.
 
-      elsif Digs = IEEES_Digits then
-         L := Real_Convert
-                (IEEES_First'Universal_Literal_String);
-         H := Real_Convert
-                (IEEES_Last'Universal_Literal_String);
-
-      elsif Digs = IEEEL_Digits then
-         L := Real_Convert
-                (IEEEL_First'Universal_Literal_String);
-         H := Real_Convert
-                (IEEEL_Last'Universal_Literal_String);
-
-      else
-         pragma Assert (Digs = IEEEX_Digits);
-
-         L := Real_Convert
-                (IEEEX_First'Universal_Literal_String);
-         H := Real_Convert
-                (IEEEX_Last'Universal_Literal_String);
-      end if;
+      H := Make_Float_Literal (Stloc, Radix, Significand, Exponent);
+      L := Make_Float_Literal (Stloc, Radix, -Significand, Exponent);
 
       Set_Etype                (L, Id);
       Set_Is_Static_Expression (L);
index 68eedfd..ad5eba9 100644 (file)
 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);
 
index e45d3d7..f496a13 100644 (file)
@@ -5094,6 +5094,17 @@ package Einfo is
    --  E_Floating_Point_Type
    --  E_Floating_Point_Subtype
    --    Digits_Value                        (Uint17)
+   --    Machine_Emax_Value                  (synth)
+   --    Machine_Emin_Value                  (synth)
+   --    Machine_Mantissa_Value              (synth)
+   --    Machine_Radix_Value                 (synth)
+   --    Model_Emin_Value                    (synth)
+   --    Model_Epsilon_Value                 (synth)
+   --    Model_Mantissa_Value                (synth)
+   --    Model_Small_Value                   (synth)
+   --    Safe_Emax_Value                     (synth)
+   --    Safe_First_Value                    (synth)
+   --    Safe_Last_Value                     (synth)
    --    Scalar_Range                        (Node20)
    --    Type_Low_Bound                      (synth)
    --    Type_High_Bound                     (synth)
@@ -6334,6 +6345,14 @@ package Einfo is
    function Is_Task_Record_Type                 (Id : E) return B;
    function Is_Wrapper_Package                  (Id : E) return B;
    function Last_Formal                         (Id : E) return E;
+   function Machine_Emax_Value                  (Id : E) return U;
+   function Machine_Emin_Value                  (Id : E) return U;
+   function Machine_Mantissa_Value              (Id : E) return U;
+   function Machine_Radix_Value                 (Id : E) return U;
+   function Model_Emin_Value                    (Id : E) return U;
+   function Model_Epsilon_Value                 (Id : E) return R;
+   function Model_Mantissa_Value                (Id : E) return U;
+   function Model_Small_Value                   (Id : E) return R;
    function Next_Component                      (Id : E) return E;
    function Next_Component_Or_Discriminant      (Id : E) return E;
    function Next_Discriminant                   (Id : E) return E;
@@ -6347,6 +6366,9 @@ package Einfo is
    function Parameter_Mode                      (Id : E) return Formal_Kind;
    function Primitive_Operations                (Id : E) return L;
    function Root_Type                           (Id : E) return E;
+   function Safe_Emax_Value                     (Id : E) return U;
+   function Safe_First_Value                    (Id : E) return R;
+   function Safe_Last_Value                     (Id : E) return R;
    function Scope_Depth_Set                     (Id : E) return B;
    function Size_Clause                         (Id : E) return N;
    function Stream_Size_Clause                  (Id : E) return N;
index 78dcea6..3d0bff6 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -25,8 +25,6 @@
 
 with Einfo;    use Einfo;
 with Errout;   use Errout;
-with Sem_Util; use Sem_Util;
-with Ttypef;   use Ttypef;
 with Targparm; use Targparm;
 
 package body Eval_Fat is
@@ -67,13 +65,11 @@ package body Eval_Fat is
       Mode     : Rounding_Mode);
    --  This is similar to Decompose, except that the Fraction value returned
    --  is an integer representing the value Fraction * Scale, where Scale is
-   --  the value (Radix ** Machine_Mantissa (RT)). The value is obtained by
-   --  using biased rounding (halfway cases round away from zero), round to
-   --  even, a floor operation or a ceiling operation depending on the setting
-   --  of Mode (see corresponding descriptions in Urealp).
-
-   function Machine_Emin (RT : R) return Int;
-   --  Return value of the Machine_Emin attribute
+   --  the value (Machine_Radix_Value (RT) ** Machine_Mantissa_Value (RT)). The
+   --  value is obtained by using biased rounding (halfway cases round away
+   --  from zero), round to even, a floor operation or a ceiling operation
+   --  depending on the setting of Mode (see corresponding descriptions in
+   --  Urealp).
 
    --------------
    -- Adjacent --
@@ -155,7 +151,7 @@ package body Eval_Fat is
 
       Fraction := UR_From_Components
        (Num      => Int_F,
-        Den      => UI_From_Int (Machine_Mantissa (RT)),
+        Den      => Machine_Mantissa_Value (RT),
         Rbase    => Radix,
         Negative => False);
 
@@ -192,7 +188,7 @@ package body Eval_Fat is
       --  True iff Fraction is even
 
       Most_Significant_Digit : constant UI :=
-                                 Radix ** (Machine_Mantissa (RT) - 1);
+                                 Radix ** (Machine_Mantissa_Value (RT) - 1);
 
       Uintp_Mark : Uintp.Save_Mark;
       --  The code is divided into blocks that systematically release
@@ -475,7 +471,7 @@ package body Eval_Fat is
    ------------------
 
    function Leading_Part (RT : R; X : T; Radix_Digits : UI) return T is
-      RD : constant UI := UI_Min (Radix_Digits, Machine_Mantissa (RT));
+      RD : constant UI := UI_Min (Radix_Digits, Machine_Mantissa_Value (RT));
       L  : UI;
       Y  : T;
    begin
@@ -496,7 +492,7 @@ package body Eval_Fat is
    is
       X_Frac : T;
       X_Exp  : UI;
-      Emin   : constant UI := UI_From_Int (Machine_Emin (RT));
+      Emin   : constant UI := Machine_Emin_Value (RT);
 
    begin
       Decompose (RT, X, X_Frac, X_Exp, Mode);
@@ -513,9 +509,8 @@ package body Eval_Fat is
 
       if X_Exp < Emin then
          declare
-            Emin_Den : constant UI :=
-                         UI_From_Int
-                           (Machine_Emin (RT) - Machine_Mantissa (RT) + 1);
+            Emin_Den : constant UI := Machine_Emin_Value (RT)
+                                        - Machine_Mantissa_Value (RT) + Uint_1;
          begin
             if X_Exp < Emin_Den or not Denorm_On_Target then
                if UR_Is_Negative (X) then
@@ -569,108 +564,6 @@ package body Eval_Fat is
       return Scaling (RT, X_Frac, X_Exp);
    end Machine;
 
-   ------------------
-   -- Machine_Emin --
-   ------------------
-
-   function Machine_Emin (RT : R) return Int is
-      Digs : constant UI := Digits_Value (RT);
-      Emin : Int;
-
-   begin
-      if Vax_Float (RT) then
-         if Digs = VAXFF_Digits then
-            Emin := VAXFF_Machine_Emin;
-
-         elsif Digs = VAXDF_Digits then
-            Emin := VAXDF_Machine_Emin;
-
-         else
-            pragma Assert (Digs = VAXGF_Digits);
-            Emin := VAXGF_Machine_Emin;
-         end if;
-
-      elsif Is_AAMP_Float (RT) then
-         if Digs = AAMPS_Digits then
-            Emin := AAMPS_Machine_Emin;
-
-         else
-            pragma Assert (Digs = AAMPL_Digits);
-            Emin := AAMPL_Machine_Emin;
-         end if;
-
-      else
-         if Digs = IEEES_Digits then
-            Emin := IEEES_Machine_Emin;
-
-         elsif Digs = IEEEL_Digits then
-            Emin := IEEEL_Machine_Emin;
-
-         else
-            pragma Assert (Digs = IEEEX_Digits);
-            Emin := IEEEX_Machine_Emin;
-         end if;
-      end if;
-
-      return Emin;
-   end Machine_Emin;
-
-   ----------------------
-   -- Machine_Mantissa --
-   ----------------------
-
-   function Machine_Mantissa (RT : R) return Nat is
-      Digs : constant UI := Digits_Value (RT);
-      Mant : Nat;
-
-   begin
-      if Vax_Float (RT) then
-         if Digs = VAXFF_Digits then
-            Mant := VAXFF_Machine_Mantissa;
-
-         elsif Digs = VAXDF_Digits then
-            Mant := VAXDF_Machine_Mantissa;
-
-         else
-            pragma Assert (Digs = VAXGF_Digits);
-            Mant := VAXGF_Machine_Mantissa;
-         end if;
-
-      elsif Is_AAMP_Float (RT) then
-         if Digs = AAMPS_Digits then
-            Mant := AAMPS_Machine_Mantissa;
-
-         else
-            pragma Assert (Digs = AAMPL_Digits);
-            Mant := AAMPL_Machine_Mantissa;
-         end if;
-
-      else
-         if Digs = IEEES_Digits then
-            Mant := IEEES_Machine_Mantissa;
-
-         elsif Digs = IEEEL_Digits then
-            Mant := IEEEL_Machine_Mantissa;
-
-         else
-            pragma Assert (Digs = IEEEX_Digits);
-            Mant := IEEEX_Machine_Mantissa;
-         end if;
-      end if;
-
-      return Mant;
-   end Machine_Mantissa;
-
-   -------------------
-   -- Machine_Radix --
-   -------------------
-
-   function Machine_Radix (RT : R) return Nat is
-      pragma Warnings (Off, RT);
-   begin
-      return Radix;
-   end Machine_Radix;
-
    -----------
    -- Model --
    -----------
@@ -818,8 +711,8 @@ package body Eval_Fat is
    ----------
 
    function Succ (RT : R; X : T) return T is
-      Emin     : constant UI := UI_From_Int (Machine_Emin (RT));
-      Mantissa : constant UI := UI_From_Int (Machine_Mantissa (RT));
+      Emin     : constant UI := Machine_Emin_Value (RT);
+      Mantissa : constant UI := Machine_Mantissa_Value (RT);
       Exp      : UI := UI_Max (Emin, Exponent (RT, X));
       Frac     : T;
       New_Frac : T;
index ec774f1..964dd22 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -65,10 +65,6 @@ package Eval_Fat is
 
    function Leading_Part      (RT : R; X : T; Radix_Digits : UI)    return T;
 
-   function Machine_Mantissa  (RT : R)                              return Nat;
-
-   function Machine_Radix     (RT : R)                              return Nat;
-
    function Model             (RT : R; X : T)                       return T;
 
    function Pred              (RT : R; X : T)                       return T;
index 9f17256..592114c 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2010, 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- --
@@ -32,12 +32,15 @@ with Sem_Res;  use Sem_Res;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Tbuild;   use Tbuild;
-with Ttypef;   use Ttypef;
 with Uintp;    use Uintp;
 with Urealp;   use Urealp;
 
 package body Exp_VFpt is
 
+   VAXFF_Digits : constant := 6;
+   VAXDF_Digits : constant := 9;
+   VAXGF_Digits : constant := 15;
+
    ----------------------
    -- Expand_Vax_Arith --
    ----------------------
index 693619e..835c093 100644 (file)
@@ -328,7 +328,6 @@ GNAT_ADA_OBJS =     \
  ada/tree_io.o \
  ada/treepr.o  \
  ada/treeprs.o \
- ada/ttypef.o  \
  ada/ttypes.o  \
  ada/types.o   \
  ada/uintp.o   \
@@ -1549,7 +1548,7 @@ ada/cstand.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
    ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
-   ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads ada/types.ads \
+   ada/tree_io.ads ada/ttypes.ads ada/types.ads \
    ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
    ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads 
 
@@ -1643,7 +1642,7 @@ ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
    ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
-   ada/tree_io.ads ada/ttypef.ads ada/types.ads ada/uintp.ads \
+   ada/tree_io.ads ada/types.ads ada/uintp.ads \
    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
    ada/urealp.adb 
 
@@ -2388,7 +2387,7 @@ ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
    ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
    ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/tbuild.ads ada/tree_io.ads ada/ttypef.ads ada/types.ads \
+   ada/tbuild.ads ada/tree_io.ads ada/types.ads \
    ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
    ada/urealp.ads ada/urealp.adb 
 
@@ -3351,7 +3350,7 @@ ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
    ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
    ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
    ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
-   ada/tbuild.adb ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads \
+   ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
    ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
    ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
    ada/validsw.ads ada/widechar.ads 
@@ -4120,7 +4119,7 @@ ada/sem_vfpt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
    ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
    ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
-   ada/tree_io.ads ada/ttypef.ads ada/types.ads ada/uintp.ads \
+   ada/tree_io.ads ada/types.ads ada/uintp.ads \
    ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads 
 
 ada/sem_warn.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
@@ -4434,8 +4433,6 @@ ada/treeprs.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/treeprs.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
    ada/unchdeal.ads ada/urealp.ads 
 
-ada/ttypef.o : ada/system.ads ada/ttypef.ads 
-
 ada/ttypes.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \
    ada/system.ads ada/s-exctab.ads ada/s-stalib.ads ada/s-unstyp.ads \
    ada/ttypes.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads 
index 1554b5d..a59bb4e 100644 (file)
@@ -6450,9 +6450,7 @@ number.  The static result is the string consisting of the characters of
 the number as defined in the original source.  This allows the user
 program to access the actual text of named numbers without intermediate
 conversions and without the need to enclose the strings in quotes (which
-would preclude their use as numbers).  This is used internally for the
-construction of values of the floating-point attributes from the file
-@file{ttypef.ads}, but may also be used by user programs.
+would preclude their use as numbers).
 
 For example, the following program prints the first 50 digits of pi:
 
@@ -9181,8 +9179,8 @@ random numbers is one microsecond.
 Annex is not supported.  See A.5.3(72).
 @end cartouche
 @noindent
-See the source file @file{ttypef.ads} for the values of all numeric
-attributes.
+Run the compiler with @option{-gnatS} to produce a listing of package
+@code{Standard}, has the values of all numeric attributes.
 
 @sp 1
 @cartouche
index 8722a78..e62e55c 100644 (file)
@@ -66,7 +66,6 @@ with Style;
 with Stylesw;  use Stylesw;
 with Targparm; use Targparm;
 with Ttypes;   use Ttypes;
-with Ttypef;   use Ttypef;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 with Urealp;   use Urealp;
@@ -4922,35 +4921,6 @@ package body Sem_Attr is
       --  but compile time known value given by Val. It includes the
       --  necessary checks for out of range values.
 
-      procedure Float_Attribute_Universal_Integer
-        (IEEES_Val : Int;
-         IEEEL_Val : Int;
-         IEEEX_Val : Int;
-         VAXFF_Val : Int;
-         VAXDF_Val : Int;
-         VAXGF_Val : Int;
-         AAMPS_Val : Int;
-         AAMPL_Val : Int);
-      --  This procedure evaluates a float attribute with no arguments that
-      --  returns a universal integer result. The parameters give the values
-      --  for the possible floating-point root types. See ttypef for details.
-      --  The prefix type is a float type (and is thus not a generic type).
-
-      procedure Float_Attribute_Universal_Real
-        (IEEES_Val : String;
-         IEEEL_Val : String;
-         IEEEX_Val : String;
-         VAXFF_Val : String;
-         VAXDF_Val : String;
-         VAXGF_Val : String;
-         AAMPS_Val : String;
-         AAMPL_Val : String);
-      --  This procedure evaluates a float attribute with no arguments that
-      --  returns a universal real result. The parameters give the values
-      --  required for the possible floating-point root types in string
-      --  format as real literals with a possible leading minus sign.
-      --  The prefix type is a float type (and is thus not a generic type).
-
       function Fore_Value return Nat;
       --  Computes the Fore value for the current attribute prefix, which is
       --  known to be a static fixed-point type. Used by Fore and Width.
@@ -5052,103 +5022,6 @@ package body Sem_Attr is
            Compile_Time_Known_Value (Type_High_Bound (Typ));
       end Compile_Time_Known_Bounds;
 
-      ---------------------------------------
-      -- Float_Attribute_Universal_Integer --
-      ---------------------------------------
-
-      procedure Float_Attribute_Universal_Integer
-        (IEEES_Val : Int;
-         IEEEL_Val : Int;
-         IEEEX_Val : Int;
-         VAXFF_Val : Int;
-         VAXDF_Val : Int;
-         VAXGF_Val : Int;
-         AAMPS_Val : Int;
-         AAMPL_Val : Int)
-      is
-         Val  : Int;
-         Digs : constant Nat := UI_To_Int (Digits_Value (P_Base_Type));
-
-      begin
-         if Vax_Float (P_Base_Type) then
-            if Digs = VAXFF_Digits then
-               Val := VAXFF_Val;
-            elsif Digs = VAXDF_Digits then
-               Val := VAXDF_Val;
-            else pragma Assert (Digs = VAXGF_Digits);
-               Val := VAXGF_Val;
-            end if;
-
-         elsif Is_AAMP_Float (P_Base_Type) then
-            if Digs = AAMPS_Digits then
-               Val := AAMPS_Val;
-            else pragma Assert (Digs = AAMPL_Digits);
-               Val := AAMPL_Val;
-            end if;
-
-         else
-            if Digs = IEEES_Digits then
-               Val := IEEES_Val;
-            elsif Digs = IEEEL_Digits then
-               Val := IEEEL_Val;
-            else pragma Assert (Digs = IEEEX_Digits);
-               Val := IEEEX_Val;
-            end if;
-         end if;
-
-         Fold_Uint (N, UI_From_Int (Val), True);
-      end Float_Attribute_Universal_Integer;
-
-      ------------------------------------
-      -- Float_Attribute_Universal_Real --
-      ------------------------------------
-
-      procedure Float_Attribute_Universal_Real
-        (IEEES_Val : String;
-         IEEEL_Val : String;
-         IEEEX_Val : String;
-         VAXFF_Val : String;
-         VAXDF_Val : String;
-         VAXGF_Val : String;
-         AAMPS_Val : String;
-         AAMPL_Val : String)
-      is
-         Val  : Node_Id;
-         Digs : constant Nat := UI_To_Int (Digits_Value (P_Base_Type));
-
-      begin
-         if Vax_Float (P_Base_Type) then
-            if Digs = VAXFF_Digits then
-               Val := Real_Convert (VAXFF_Val);
-            elsif Digs = VAXDF_Digits then
-               Val := Real_Convert (VAXDF_Val);
-            else pragma Assert (Digs = VAXGF_Digits);
-               Val := Real_Convert (VAXGF_Val);
-            end if;
-
-         elsif Is_AAMP_Float (P_Base_Type) then
-            if Digs = AAMPS_Digits then
-               Val := Real_Convert (AAMPS_Val);
-            else pragma Assert (Digs = AAMPL_Digits);
-               Val := Real_Convert (AAMPL_Val);
-            end if;
-
-         else
-            if Digs = IEEES_Digits then
-               Val := Real_Convert (IEEES_Val);
-            elsif Digs = IEEEL_Digits then
-               Val := Real_Convert (IEEEL_Val);
-            else pragma Assert (Digs = IEEEX_Digits);
-               Val := Real_Convert (IEEEX_Val);
-            end if;
-         end if;
-
-         Set_Sloc (Val, Loc);
-         Rewrite (N, Val);
-         Set_Is_Static_Expression (N, Static);
-         Analyze_And_Resolve (N, C_Type);
-      end Float_Attribute_Universal_Real;
-
       ----------------
       -- Fore_Value --
       ----------------
@@ -6402,45 +6275,21 @@ package body Sem_Attr is
       ------------------
 
       when Attribute_Machine_Emax =>
-         Float_Attribute_Universal_Integer (
-           IEEES_Machine_Emax,
-           IEEEL_Machine_Emax,
-           IEEEX_Machine_Emax,
-           VAXFF_Machine_Emax,
-           VAXDF_Machine_Emax,
-           VAXGF_Machine_Emax,
-           AAMPS_Machine_Emax,
-           AAMPL_Machine_Emax);
+         Fold_Uint (N, Machine_Emax_Value (P_Type), Static);
 
       ------------------
       -- Machine_Emin --
       ------------------
 
       when Attribute_Machine_Emin =>
-         Float_Attribute_Universal_Integer (
-           IEEES_Machine_Emin,
-           IEEEL_Machine_Emin,
-           IEEEX_Machine_Emin,
-           VAXFF_Machine_Emin,
-           VAXDF_Machine_Emin,
-           VAXGF_Machine_Emin,
-           AAMPS_Machine_Emin,
-           AAMPL_Machine_Emin);
+         Fold_Uint (N, Machine_Emin_Value (P_Type), Static);
 
       ----------------------
       -- Machine_Mantissa --
       ----------------------
 
       when Attribute_Machine_Mantissa =>
-         Float_Attribute_Universal_Integer (
-           IEEES_Machine_Mantissa,
-           IEEEL_Machine_Mantissa,
-           IEEEX_Machine_Mantissa,
-           VAXFF_Machine_Mantissa,
-           VAXDF_Machine_Mantissa,
-           VAXGF_Machine_Mantissa,
-           AAMPS_Machine_Mantissa,
-           AAMPL_Machine_Mantissa);
+         Fold_Uint (N, Machine_Mantissa_Value (P_Type), Static);
 
       -----------------------
       -- Machine_Overflows --
@@ -6731,60 +6580,28 @@ package body Sem_Attr is
       ----------------
 
       when Attribute_Model_Emin =>
-         Float_Attribute_Universal_Integer (
-           IEEES_Model_Emin,
-           IEEEL_Model_Emin,
-           IEEEX_Model_Emin,
-           VAXFF_Model_Emin,
-           VAXDF_Model_Emin,
-           VAXGF_Model_Emin,
-           AAMPS_Model_Emin,
-           AAMPL_Model_Emin);
+         Fold_Uint (N, Model_Emin_Value (P_Base_Type), Static);
 
       -------------------
       -- Model_Epsilon --
       -------------------
 
       when Attribute_Model_Epsilon =>
-         Float_Attribute_Universal_Real (
-           IEEES_Model_Epsilon'Universal_Literal_String,
-           IEEEL_Model_Epsilon'Universal_Literal_String,
-           IEEEX_Model_Epsilon'Universal_Literal_String,
-           VAXFF_Model_Epsilon'Universal_Literal_String,
-           VAXDF_Model_Epsilon'Universal_Literal_String,
-           VAXGF_Model_Epsilon'Universal_Literal_String,
-           AAMPS_Model_Epsilon'Universal_Literal_String,
-           AAMPL_Model_Epsilon'Universal_Literal_String);
+         Fold_Ureal (N, Model_Epsilon_Value (P_Base_Type), Static);
 
       --------------------
       -- Model_Mantissa --
       --------------------
 
       when Attribute_Model_Mantissa =>
-         Float_Attribute_Universal_Integer (
-           IEEES_Model_Mantissa,
-           IEEEL_Model_Mantissa,
-           IEEEX_Model_Mantissa,
-           VAXFF_Model_Mantissa,
-           VAXDF_Model_Mantissa,
-           VAXGF_Model_Mantissa,
-           AAMPS_Model_Mantissa,
-           AAMPL_Model_Mantissa);
+         Fold_Uint (N, Model_Mantissa_Value (P_Base_Type), Static);
 
       -----------------
       -- Model_Small --
       -----------------
 
       when Attribute_Model_Small =>
-         Float_Attribute_Universal_Real (
-           IEEES_Model_Small'Universal_Literal_String,
-           IEEEL_Model_Small'Universal_Literal_String,
-           IEEEX_Model_Small'Universal_Literal_String,
-           VAXFF_Model_Small'Universal_Literal_String,
-           VAXDF_Model_Small'Universal_Literal_String,
-           VAXGF_Model_Small'Universal_Literal_String,
-           AAMPS_Model_Small'Universal_Literal_String,
-           AAMPL_Model_Small'Universal_Literal_String);
+         Fold_Ureal (N, Model_Small_Value (P_Base_Type), Static);
 
       -------------
       -- Modulus --
@@ -7002,30 +6819,14 @@ package body Sem_Attr is
       ---------------
 
       when Attribute_Safe_Emax =>
-         Float_Attribute_Universal_Integer (
-           IEEES_Safe_Emax,
-           IEEEL_Safe_Emax,
-           IEEEX_Safe_Emax,
-           VAXFF_Safe_Emax,
-           VAXDF_Safe_Emax,
-           VAXGF_Safe_Emax,
-           AAMPS_Safe_Emax,
-           AAMPL_Safe_Emax);
+         Fold_Uint (N, Safe_Emax_Value (P_Type), Static);
 
       ----------------
       -- Safe_First --
       ----------------
 
       when Attribute_Safe_First =>
-         Float_Attribute_Universal_Real (
-           IEEES_Safe_First'Universal_Literal_String,
-           IEEEL_Safe_First'Universal_Literal_String,
-           IEEEX_Safe_First'Universal_Literal_String,
-           VAXFF_Safe_First'Universal_Literal_String,
-           VAXDF_Safe_First'Universal_Literal_String,
-           VAXGF_Safe_First'Universal_Literal_String,
-           AAMPS_Safe_First'Universal_Literal_String,
-           AAMPL_Safe_First'Universal_Literal_String);
+         Fold_Ureal (N, Safe_First_Value (P_Type), Static);
 
       ----------------
       -- Safe_Large --
@@ -7036,15 +6837,7 @@ package body Sem_Attr is
             Fold_Ureal
               (N, Expr_Value_R (Type_High_Bound (P_Base_Type)), Static);
          else
-            Float_Attribute_Universal_Real (
-              IEEES_Safe_Large'Universal_Literal_String,
-              IEEEL_Safe_Large'Universal_Literal_String,
-              IEEEX_Safe_Large'Universal_Literal_String,
-              VAXFF_Safe_Large'Universal_Literal_String,
-              VAXDF_Safe_Large'Universal_Literal_String,
-              VAXGF_Safe_Large'Universal_Literal_String,
-              AAMPS_Safe_Large'Universal_Literal_String,
-              AAMPL_Safe_Large'Universal_Literal_String);
+            Fold_Ureal (N, Safe_Last_Value (P_Type), Static);
          end if;
 
       ---------------
@@ -7052,15 +6845,7 @@ package body Sem_Attr is
       ---------------
 
       when Attribute_Safe_Last =>
-         Float_Attribute_Universal_Real (
-           IEEES_Safe_Last'Universal_Literal_String,
-           IEEEL_Safe_Last'Universal_Literal_String,
-           IEEEX_Safe_Last'Universal_Literal_String,
-           VAXFF_Safe_Last'Universal_Literal_String,
-           VAXDF_Safe_Last'Universal_Literal_String,
-           VAXGF_Safe_Last'Universal_Literal_String,
-           AAMPS_Safe_Last'Universal_Literal_String,
-           AAMPL_Safe_Last'Universal_Literal_String);
+         Fold_Ureal (N, Safe_Last_Value (P_Type), Static);
 
       ----------------
       -- Safe_Small --
@@ -7078,15 +6863,7 @@ package body Sem_Attr is
          --  Ada 83 Safe_Small for floating-point cases
 
          else
-            Float_Attribute_Universal_Real (
-              IEEES_Safe_Small'Universal_Literal_String,
-              IEEEL_Safe_Small'Universal_Literal_String,
-              IEEEX_Safe_Small'Universal_Literal_String,
-              VAXFF_Safe_Small'Universal_Literal_String,
-              VAXDF_Safe_Small'Universal_Literal_String,
-              VAXGF_Safe_Small'Universal_Literal_String,
-              AAMPS_Safe_Small'Universal_Literal_String,
-              AAMPL_Safe_Small'Universal_Literal_String);
+            Fold_Ureal (N, Model_Small_Value (P_Type), Static);
          end if;
 
       -----------
index b1a6150..6db8949 100644 (file)
@@ -502,15 +502,12 @@ package Sem_Attr is
       ------------------------------
 
       Attribute_Universal_Literal_String => True,
-      --  The prefix of 'Universal_Literal_String must be a named number. The
-      --  static result is the string consisting of the characters of the
-      --  number as defined in the original source. This allows the user
-      --  program to access the actual text of named numbers without
-      --  intermediate conversions and without the need to enclose the strings
-      --  in quotes (which would preclude their use as numbers). This is used
-      --  internally for the construction of values of the floating-point
-      --  attributes from the file ttypef.ads, but may also be used by user
-      --  programs.
+      --  The prefix of 'Universal_Literal_String must be a named number.
+      --  The static result is the string consisting of the characters of
+      --  the number as defined in the original source. This allows the
+      --  user program to access the actual text of named numbers without
+      --  intermediate conversions and without the need to enclose the
+      --  strings in quotes (which would preclude their use as numbers).
 
       -------------------------
       -- Unrestricted_Access --
index 676051d..109ee58 100644 (file)
@@ -41,8 +41,6 @@ with Nlists;   use Nlists;
 with Output;   use Output;
 with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
-with Scans;    use Scans;
-with Scn;      use Scn;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Attr; use Sem_Attr;
@@ -10164,45 +10162,6 @@ package body Sem_Util is
       Set_Sloc (Endl, Loc);
    end Process_End_Label;
 
-   ------------------
-   -- Real_Convert --
-   ------------------
-
-   --  We do the conversion to get the value of the real string by using
-   --  the scanner, see Sinput for details on use of the internal source
-   --  buffer for scanning internal strings.
-
-   function Real_Convert (S : String) return Node_Id is
-      Save_Src : constant Source_Buffer_Ptr := Source;
-      Negative : Boolean;
-
-   begin
-      Source := Internal_Source_Ptr;
-      Scan_Ptr := 1;
-
-      for J in S'Range loop
-         Source (Source_Ptr (J)) := S (J);
-      end loop;
-
-      Source (S'Length + 1) := EOF;
-
-      if Source (Scan_Ptr) = '-' then
-         Negative := True;
-         Scan_Ptr := Scan_Ptr + 1;
-      else
-         Negative := False;
-      end if;
-
-      Scan;
-
-      if Negative then
-         Set_Realval (Token_Node, UR_Negate (Realval (Token_Node)));
-      end if;
-
-      Source := Save_Src;
-      return Token_Node;
-   end Real_Convert;
-
    ------------------------------------
    -- References_Generic_Formal_Type --
    ------------------------------------
index ec33099..be4987b 100644 (file)
@@ -1096,10 +1096,6 @@ package Sem_Util is
    --  parameter Ent gives the entity to which the End_Label refers,
    --  and to which cross-references are to be generated.
 
-   function Real_Convert (S : String) return Node_Id;
-   --  S is a possibly signed syntactically valid real literal. The result
-   --  returned is an N_Real_Literal node representing the literal value.
-
    function References_Generic_Formal_Type (N : Node_Id) return Boolean;
    --  Returns True if the expression Expr contains any references to a
    --  generic type. This can only happen within a generic template.
index 01a0958..2ffd122 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2010, 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- --
@@ -28,7 +28,6 @@ with Einfo;    use Einfo;
 with Opt;      use Opt;
 with Stand;    use Stand;
 with Targparm; use Targparm;
-with Ttypef;   use Ttypef;
 
 package body Sem_VFpt is
 
@@ -37,6 +36,8 @@ package body Sem_VFpt is
    -----------------
 
    procedure Set_D_Float (E : Entity_Id) is
+      VAXDF_Digits : constant := 9;
+
    begin
       Init_Size         (Base_Type (E), 64);
       Init_Alignment    (Base_Type (E));
@@ -55,6 +56,8 @@ package body Sem_VFpt is
    -----------------
 
    procedure Set_F_Float (E : Entity_Id) is
+      VAXFF_Digits : constant := 6;
+
    begin
       Init_Size         (Base_Type (E), 32);
       Init_Alignment    (Base_Type (E));
@@ -73,6 +76,8 @@ package body Sem_VFpt is
    -----------------
 
    procedure Set_G_Float (E : Entity_Id) is
+      VAXGF_Digits : constant := 15;
+
    begin
       Init_Size         (Base_Type (E), 64);
       Init_Alignment    (Base_Type (E));
@@ -91,6 +96,8 @@ package body Sem_VFpt is
    -------------------
 
    procedure Set_IEEE_Long (E : Entity_Id) is
+      IEEEL_Digits : constant := 15;
+
    begin
       Init_Size         (Base_Type (E), 64);
       Init_Alignment    (Base_Type (E));
@@ -109,6 +116,8 @@ package body Sem_VFpt is
    --------------------
 
    procedure Set_IEEE_Short (E : Entity_Id) is
+      IEEES_Digits : constant := 6;
+
    begin
       Init_Size         (Base_Type (E), 32);
       Init_Alignment    (Base_Type (E));
index ed9a713..3edb41e 100644 (file)
@@ -36,7 +36,7 @@ with Sem_Aux;  use Sem_Aux;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
-with Uintp;    use Uintp;
+with Urealp;   use Urealp;
 
 package body Tbuild is
 
@@ -198,6 +198,40 @@ package body Tbuild is
               New_Reference_To (First_Tag_Component (Full_Type), Loc)));
    end Make_DT_Access;
 
+   ------------------------
+   -- Make_Float_Literal --
+   ------------------------
+
+   function Make_Float_Literal
+     (Loc         : Source_Ptr;
+      Radix       : Uint;
+      Significand : Uint;
+      Exponent    : Uint) return Node_Id
+   is
+   begin
+      if Radix = 2 and then abs Significand /= 1 then
+         return
+           Make_Float_Literal
+             (Loc, Uint_16,
+              Significand * Radix**(Exponent mod 4),
+              Exponent / 4);
+
+      else
+         declare
+            N : constant Node_Id := New_Node (N_Real_Literal, Loc);
+
+         begin
+            Set_Realval (N,
+              UR_From_Components
+                (Num      => abs Significand,
+                 Den      => -Exponent,
+                 Rbase    => UI_To_Int (Radix),
+                 Negative => Significand < 0));
+            return N;
+         end;
+      end if;
+   end Make_Float_Literal;
+
    -------------------------------------
    -- Make_Implicit_Exception_Handler --
    -------------------------------------
index 69cc20f..9ba0427 100644 (file)
@@ -29,6 +29,7 @@
 with Namet; use Namet;
 with Sinfo; use Sinfo;
 with Types; use Types;
+with Uintp; use Uintp;
 
 package Tbuild is
 
@@ -75,6 +76,14 @@ package Tbuild is
    --  Create an access to the Dispatch Table by using the Tag field of a
    --  tagged record : Acc_Dt (Rec.tag).all
 
+   function Make_Float_Literal
+     (Loc         : Source_Ptr;
+      Radix       : Uint;
+      Significand : Uint;
+      Exponent    : Uint) return Node_Id;
+   --  Create a real literal for the floating point expression value
+   --  Significand * Radix ** Exponent. Radix must be greater than 1.
+
    function Make_Implicit_Exception_Handler
      (Sloc              : Source_Ptr;
       Choice_Parameter  : Node_Id := Empty;
diff --git a/gcc/ada/ttypef.ads b/gcc/ada/ttypef.ads
deleted file mode 100644 (file)
index 58cdbff..0000000
+++ /dev/null
@@ -1,204 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT COMPILER COMPONENTS                         --
---                                                                          --
---                               T T Y P E F                                --
---                                                                          --
---                                 S p e c                                  --
---                                                                          --
---          Copyright (C) 1992-2010, 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.  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 COPYING3.  If not, go to --
--- http://www.gnu.org/licenses for a complete copy of the license.          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  This module contains values for the predefined floating-point attributes.
---  All references to these attribute values in a program being compiled must
---  use the values in this package, not the values returned by referencing
---  the corresponding attributes (since that would give host machine values).
---  Boolean-valued attributes are defined in System.Parameters, because they
---  need a finer control than what is provided by the formats described below.
-
---  The codes for the eight floating-point formats supported are:
-
---      IEEES - IEEE Single Float
---      IEEEL - IEEE Double Float
---      IEEEX - IEEE Double Extended Float
---      VAXFF - VAX F Float
---      VAXDF - VAX D Float
---      VAXGF - VAX G Float
---      AAMPS - AAMP 32-bit Float
---      AAMPL - AAMP 48-bit Float
-
-package Ttypef is
-
-   ----------------------------------
-   -- Universal Integer Attributes --
-   ----------------------------------
-
-   --  Note that the constant declarations below specify values
-   --  using the Ada model, so IEEES_Machine_Emax does not specify
-   --  the IEEE definition of the single precision float type,
-   --  but the value of the Ada attribute which is one higher
-   --  as the binary point is at a different location.
-
-   IEEES_Digits            : constant := 6;
-   IEEEL_Digits            : constant := 15;
-   IEEEX_Digits            : constant := 18;
-   VAXFF_Digits            : constant := 6;
-   VAXDF_Digits            : constant := 9;
-   VAXGF_Digits            : constant := 15;
-   AAMPS_Digits            : constant := 6;
-   AAMPL_Digits            : constant := 9;
-
-   IEEES_Machine_Emax      : constant := 128;
-   IEEEL_Machine_Emax      : constant := 1024;
-   IEEEX_Machine_Emax      : constant := 16384;
-   VAXFF_Machine_Emax      : constant := 127;
-   VAXDF_Machine_Emax      : constant := 127;
-   VAXGF_Machine_Emax      : constant := 1023;
-   AAMPS_Machine_Emax      : constant := 127;
-   AAMPL_Machine_Emax      : constant := 127;
-
-   IEEES_Machine_Emin      : constant := -125;
-   IEEEL_Machine_Emin      : constant := -1021;
-   IEEEX_Machine_Emin      : constant := -16381;
-   VAXFF_Machine_Emin      : constant := -127;
-   VAXDF_Machine_Emin      : constant := -127;
-   VAXGF_Machine_Emin      : constant := -1023;
-   AAMPS_Machine_Emin      : constant := -127;
-   AAMPL_Machine_Emin      : constant := -127;
-
-   IEEES_Machine_Mantissa  : constant := 24;
-   IEEEL_Machine_Mantissa  : constant := 53;
-   IEEEX_Machine_Mantissa  : constant := 64;
-   VAXFF_Machine_Mantissa  : constant := 24;
-   VAXDF_Machine_Mantissa  : constant := 56;
-   VAXGF_Machine_Mantissa  : constant := 53;
-   AAMPS_Machine_Mantissa  : constant := 24;
-   AAMPL_Machine_Mantissa  : constant := 40;
-
-   IEEES_Model_Emin        : constant := -125;
-   IEEEL_Model_Emin        : constant := -1021;
-   IEEEX_Model_Emin        : constant := -16381;
-   VAXFF_Model_Emin        : constant := -127;
-   VAXDF_Model_Emin        : constant := -127;
-   VAXGF_Model_Emin        : constant := -1023;
-   AAMPS_Model_Emin        : constant := -127;
-   AAMPL_Model_Emin        : constant := -127;
-
-   IEEES_Model_Mantissa    : constant := 24;
-   IEEEL_Model_Mantissa    : constant := 53;
-   IEEEX_Model_Mantissa    : constant := 64;
-   VAXFF_Model_Mantissa    : constant := 24;
-   VAXDF_Model_Mantissa    : constant := 56;
-   VAXGF_Model_Mantissa    : constant := 53;
-   AAMPS_Model_Mantissa    : constant := 24;
-   AAMPL_Model_Mantissa    : constant := 40;
-
-   IEEES_Safe_Emax         : constant := 128;
-   IEEEL_Safe_Emax         : constant := 1024;
-   IEEEX_Safe_Emax         : constant := 16384;
-   VAXFF_Safe_Emax         : constant := 127;
-   VAXDF_Safe_Emax         : constant := 127;
-   VAXGF_Safe_Emax         : constant := 1023;
-   AAMPS_Safe_Emax         : constant := 127;
-   AAMPL_Safe_Emax         : constant := 127;
-
-   -------------------------------
-   -- Universal Real Attributes --
-   -------------------------------
-
-   IEEES_Model_Epsilon     : constant := 2#1.0#E-23;
-   IEEEL_Model_Epsilon     : constant := 2#1.0#E-52;
-   IEEEX_Model_Epsilon     : constant := 2#1.0#E-63;
-   VAXFF_Model_Epsilon     : constant := 2#1.0#E-23;
-   VAXDF_Model_Epsilon     : constant := 2#1.0#E-55;
-   VAXGF_Model_Epsilon     : constant := 2#1.0#E-52;
-   AAMPS_Model_Epsilon     : constant := 2#1.0#E-23;
-   AAMPL_Model_Epsilon     : constant := 2#1.0#E-39;
-
-   IEEES_Model_Small       : constant := 2#1.0#E-126;
-   IEEEL_Model_Small       : constant := 2#1.0#E-1022;
-   IEEEX_Model_Small       : constant := 2#1.0#E-16382;
-   VAXFF_Model_Small       : constant := 2#1.0#E-128;
-   VAXDF_Model_Small       : constant := 2#1.0#E-128;
-   VAXGF_Model_Small       : constant := 2#1.0#E-1024;
-   AAMPS_Model_Small       : constant := 2#1.0#E-128;
-   AAMPL_Model_Small       : constant := 2#1.0#E-128;
-
-   IEEES_Safe_First        : constant := -16#0.FFFF_FF#E+32;
-   IEEEL_Safe_First        : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256;
-   IEEEX_Safe_First        : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
-   VAXFF_Safe_First        : constant := -16#0.7FFF_FF8#E+32;
-   VAXDF_Safe_First        : constant := -16#0.7FFF_FFFF_FFFF_FF8#E+32;
-   VAXGF_Safe_First        : constant := -16#0.7FFF_FFFF_FFFF_FC#E+256;
-   AAMPS_Safe_First        : constant := -16#0.7FFF_FF8#E+32;
-   AAMPL_Safe_First        : constant := -16#0.7FFF_FFFF_FF8#E+32;
-
-   IEEES_Safe_Large        : constant := 16#0.FFFF_FF#E+32;
-   IEEEL_Safe_Large        : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256;
-   IEEEX_Safe_Large        : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
-   VAXFF_Safe_Large        : constant := 16#0.7FFF_FF8#E+32;
-   VAXDF_Safe_Large        : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32;
-   VAXGF_Safe_Large        : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256;
-   AAMPS_Safe_Large        : constant := 16#0.7FFF_FF8#E+32;
-   AAMPL_Safe_Large        : constant := 16#0.7FFF_FFFF_FF8#E+32;
-
-   IEEES_Safe_Last         : constant := 16#0.FFFF_FF#E+32;
-   IEEEL_Safe_Last         : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256;
-   IEEEX_Safe_Last         : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
-   VAXFF_Safe_Last         : constant := 16#0.7FFF_FF8#E+32;
-   VAXDF_Safe_Last         : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32;
-   VAXGF_Safe_Last         : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256;
-   AAMPS_Safe_Last         : constant := 16#0.7FFF_FF8#E+32;
-   AAMPL_Safe_Last         : constant := 16#0.7FFF_FFFF_FF8#E+32;
-
-   IEEES_Safe_Small        : constant := 2#1.0#E-126;
-   IEEEL_Safe_Small        : constant := 2#1.0#E-1022;
-   IEEEX_Safe_Small        : constant := 2#1.0#E-16382;
-   VAXFF_Safe_Small        : constant := 2#1.0#E-128;
-   VAXDF_Safe_Small        : constant := 2#1.0#E-128;
-   VAXGF_Safe_Small        : constant := 2#1.0#E-1024;
-   AAMPS_Safe_Small        : constant := 2#1.0#E-128;
-   AAMPL_Safe_Small        : constant := 2#1.0#E-128;
-
-   ----------------------
-   -- Typed Attributes --
-   ----------------------
-
-   --  The attributes First and Last are typed attributes in Ada, and yield
-   --  values of the appropriate float type. However we still describe them
-   --  as universal real values in this file, since we are talking about the
-   --  target floating-point types, not the host floating-point types.
-
-   IEEES_First             : constant := -16#0.FFFF_FF#E+32;
-   IEEEL_First             : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256;
-   IEEEX_First             : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
-   VAXFF_First             : constant := -16#0.7FFF_FF8#E+32;
-   VAXDF_First             : constant := -16#0.7FFF_FFFF_FFFF_FF8#E+32;
-   VAXGF_First             : constant := -16#0.7FFF_FFFF_FFFF_FC#E+256;
-   AAMPS_First             : constant := -16#0.7FFF_FF8#E+32;
-   AAMPL_First             : constant := -16#0.7FFF_FFFF_FF8#E+32;
-
-   IEEES_Last              : constant := 16#0.FFFF_FF#E+32;
-   IEEEL_Last              : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256;
-   IEEEX_Last              : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
-   VAXFF_Last              : constant := 16#0.7FFF_FF8#E+32;
-   VAXDF_Last              : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32;
-   VAXGF_Last              : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256;
-   AAMPS_Last              : constant := 16#0.7FFF_FF8#E+32;
-   AAMPL_Last              : constant := 16#0.7FFF_FFFF_FF8#E+32;
-
-end Ttypef;