summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-10-22 09:28:24 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-10-22 09:28:24 +0000
commite8548746a5f859f185985d092e08839492f70f21 (patch)
tree7f0e836c6c46bdea870554de215d6ec19f206413
parent701d57a469be1d9ec623d0896a939936df2a0593 (diff)
downloadgcc-e8548746a5f859f185985d092e08839492f70f21.tar.gz
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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165808 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog49
-rw-r--r--gcc/ada/checks.adb4
-rw-r--r--gcc/ada/cstand.adb133
-rw-r--r--gcc/ada/einfo.adb163
-rw-r--r--gcc/ada/einfo.ads22
-rw-r--r--gcc/ada/eval_fat.adb135
-rw-r--r--gcc/ada/eval_fat.ads6
-rw-r--r--gcc/ada/exp_vfpt.adb7
-rw-r--r--gcc/ada/gcc-interface/Make-lang.in13
-rw-r--r--gcc/ada/gnat_rm.texi8
-rw-r--r--gcc/ada/sem_attr.adb247
-rw-r--r--gcc/ada/sem_attr.ads15
-rw-r--r--gcc/ada/sem_util.adb41
-rw-r--r--gcc/ada/sem_util.ads4
-rw-r--r--gcc/ada/sem_vfpt.adb13
-rw-r--r--gcc/ada/tbuild.adb36
-rw-r--r--gcc/ada/tbuild.ads9
-rw-r--r--gcc/ada/ttypef.ads204
18 files changed, 346 insertions, 763 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ff1fba1b558..0dd91b931d8 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 17b9fcb9eb3..234317ff207 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -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
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index bc85f0c5044..db1034fec6c 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -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);
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 68eedfd0bdb..ad5eba98474 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);
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index e45d3d7c2f6..f496a131a9c 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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;
diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb
index 78dcea60165..3d0bff6a30f 100644
--- a/gcc/ada/eval_fat.adb
+++ b/gcc/ada/eval_fat.adb
@@ -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;
diff --git a/gcc/ada/eval_fat.ads b/gcc/ada/eval_fat.ads
index ec774f1c3c7..964dd2224a5 100644
--- a/gcc/ada/eval_fat.ads
+++ b/gcc/ada/eval_fat.ads
@@ -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;
diff --git a/gcc/ada/exp_vfpt.adb b/gcc/ada/exp_vfpt.adb
index 9f172566cf5..592114cf1d8 100644
--- a/gcc/ada/exp_vfpt.adb
+++ b/gcc/ada/exp_vfpt.adb
@@ -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 --
----------------------
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index 693619e57e5..835c0935980 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -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
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 1554b5dfad7..a59bb4e86c4 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -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
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 8722a784dc5..e62e55cde09 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -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;
-----------
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index b1a61501f2d..6db8949be33 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -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 --
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 676051d379c..109ee580976 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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 --
------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index ec330992cd2..be4987b9494 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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.
diff --git a/gcc/ada/sem_vfpt.adb b/gcc/ada/sem_vfpt.adb
index 01a0958cf67..2ffd122278d 100644
--- a/gcc/ada/sem_vfpt.adb
+++ b/gcc/ada/sem_vfpt.adb
@@ -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));
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index ed9a7138c43..3edb41e6e93 100644
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -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 --
-------------------------------------
diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads
index 69cc20fcd4e..9ba04270592 100644
--- a/gcc/ada/tbuild.ads
+++ b/gcc/ada/tbuild.ads
@@ -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
index 58cdbff8342..00000000000
--- a/gcc/ada/ttypef.ads
+++ /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;