aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGeert Bosch <bosch@adacore.com>2010-10-22 10:15:36 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2010-10-22 12:15:36 +0200
commit23c799b1580c919c709a8144c27b53e013cd65e7 (patch)
tree552343c1a233a7faa791e3cc6cd60dc65e2dfa77
parentb4ca2d2c08cde1619a2394a02773712ded61dbce (diff)
downloadgcc-23c799b1580c919c709a8144c27b53e013cd65e7.zip
gcc-23c799b1580c919c709a8144c27b53e013cd65e7.tar.gz
gcc-23c799b1580c919c709a8144c27b53e013cd65e7.tar.bz2
cstand.adb (Build_Float_Type): Set Float_Rep according to platform.
2010-10-22 Geert Bosch <bosch@adacore.com> * cstand.adb (Build_Float_Type): Set Float_Rep according to platform. * einfo.ads (Float_Rep): New attribute. (Float_Rep_Kind): Move from body. Add comments. * einfo.adb (Float_Rep_Kind): Move to spec (Float_Rep): Now a real field instead of local function. (Set_Float_Rep): New procedure to set floating point representation (Set_Vax_Float): Remove. (Write_Entity_Flags): Remove Vax_Float flag. (Write_Field10_Name): Add E_Floating_Point_Type case for Float_Rep. * exp_attr.adb (Attribute_Valid): Use case statement for representation specific processing. * sem_ch3.adb (Build_Derived_Numeric_Type, Floating_Point_Type_Declaration): Set Float_Rep instead of Vax_Float attribute. * sem_util.ads, sem_util.adb (Is_AAMP_Float): Remove. * sem_vfpt.adb (Set_D_Float, Set_F_Float, Set_G_Float, Set_IEEE_Long, Set_IEEE_Short): Set Float_Rep instead of Vax_Float attribute. From-SVN: r165816
-rw-r--r--gcc/ada/ChangeLog20
-rw-r--r--gcc/ada/cstand.adb15
-rw-r--r--gcc/ada/einfo.adb41
-rw-r--r--gcc/ada/einfo.ads27
-rw-r--r--gcc/ada/exp_attr.adb83
-rw-r--r--gcc/ada/sem_ch3.adb4
-rw-r--r--gcc/ada/sem_util.adb12
-rw-r--r--gcc/ada/sem_util.ads8
-rw-r--r--gcc/ada/sem_vfpt.adb15
9 files changed, 114 insertions, 111 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a726dd9..f9c259f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2010-10-22 Geert Bosch <bosch@adacore.com>
+
+ * cstand.adb (Build_Float_Type): Set Float_Rep according to platform.
+ * einfo.ads (Float_Rep): New attribute.
+ (Float_Rep_Kind): Move from body. Add comments.
+ * einfo.adb (Float_Rep_Kind): Move to spec
+ (Float_Rep): Now a real field instead of local function.
+ (Set_Float_Rep): New procedure to set floating point representation
+ (Set_Vax_Float): Remove.
+ (Write_Entity_Flags): Remove Vax_Float flag.
+ (Write_Field10_Name): Add E_Floating_Point_Type case for Float_Rep.
+ * exp_attr.adb (Attribute_Valid): Use case statement for representation
+ specific processing.
+ * sem_ch3.adb (Build_Derived_Numeric_Type,
+ Floating_Point_Type_Declaration): Set Float_Rep instead of Vax_Float
+ attribute.
+ * sem_util.ads, sem_util.adb (Is_AAMP_Float): Remove.
+ * sem_vfpt.adb (Set_D_Float, Set_F_Float, Set_G_Float, Set_IEEE_Long,
+ Set_IEEE_Short): Set Float_Rep instead of Vax_Float attribute.
+
2010-10-22 Robert Dewar <dewar@adacore.com>
* sprint.adb: Minor reformatting.
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index db1034f..2f057ff 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -140,8 +140,17 @@ package body CStand is
Set_Type_Definition (Parent (E),
Make_Floating_Point_Definition (Stloc,
Digits_Expression => Make_Integer (UI_From_Int (Digs))));
+
Set_Ekind (E, E_Floating_Point_Type);
Set_Etype (E, E);
+
+ if AAMP_On_Target then
+ Set_Float_Rep (E, AAMP);
+
+ else
+ Set_Float_Rep (E, IEEE_Binary);
+ end if;
+
Init_Size (E, Siz);
Set_Elem_Alignment (E);
Init_Digits_Value (E, Digs);
@@ -1874,9 +1883,9 @@ package body CStand is
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.
+ -- Standard, Float_Rep will never be VAX_Native. Circuitry in Sem_Vfpt
+ -- will adjust these types appropriately VAX_Native if a pragma
+ -- Float_Representation (VAX_Float) is used.
H := Make_Float_Literal (Stloc, Radix, Significand, Exponent);
L := Make_Float_Literal (Stloc, Radix, -Significand, Exponent);
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index ad5eba9..8da546f 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -37,7 +37,6 @@ with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
with Stand; use Stand;
-with Targparm; use Targparm;
package body Einfo is
@@ -88,6 +87,7 @@ package body Einfo is
-- Direct_Primitive_Operations Elist10
-- Discriminal_Link Node10
+ -- Float_Rep Uint10 (but returns Float_Rep_Kind)
-- Handler_Records List10
-- Normalized_Position_Max Uint10
@@ -406,7 +406,7 @@ package body Einfo is
-- Is_Compilation_Unit Flag149
-- Has_Pragma_Elaborate_Body Flag150
- -- Vax_Float Flag151
+ -- (unused) Flag151
-- Entry_Accepted Flag152
-- Is_Obsolescent Flag153
-- Has_Per_Object_Constraint Flag154
@@ -521,12 +521,6 @@ package body Einfo is
-- (unused) Flag253
-- (unused) Flag254
- -----------------
- -- Local types --
- -----------------
-
- type Float_Rep_Kind is (IEEE_Binary, VAX_Native, AAMP);
-
-----------------------
-- Local subprograms --
-----------------------
@@ -535,23 +529,14 @@ 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
+ function Float_Rep (Id : E) return F 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;
+ return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));
end Float_Rep;
----------------
@@ -2873,7 +2858,7 @@ package body Einfo is
function Vax_Float (Id : E) return B is
begin
- return Flag151 (Base_Type (Id));
+ return Is_Floating_Point_Type (Id) and then Float_Rep (Id) = VAX_Native;
end Vax_Float;
function Warnings_Off (Id : E) return B is
@@ -3685,6 +3670,12 @@ package body Einfo is
Set_Node6 (Id, V);
end Set_First_Rep_Item;
+ procedure Set_Float_Rep (Id : E; V : F) is
+ pragma Assert (Ekind (Id) = E_Floating_Point_Type);
+ begin
+ Set_Uint10 (Id, UI_From_Int (F'Pos (V)));
+ end Set_Float_Rep;
+
procedure Set_Freeze_Node (Id : E; V : N) is
begin
Set_Node7 (Id, V);
@@ -5375,12 +5366,6 @@ package body Einfo is
Set_Flag222 (Id, V);
end Set_Used_As_Generic_Actual;
- procedure Set_Vax_Float (Id : E; V : B := True) is
- begin
- pragma Assert (Id = Base_Type (Id));
- Set_Flag151 (Id, V);
- end Set_Vax_Float;
-
procedure Set_Warnings_Off (Id : E; V : B := True) is
begin
Set_Flag96 (Id, V);
@@ -7499,7 +7484,6 @@ package body Einfo is
W ("Universal_Aliasing", Flag216 (Id));
W ("Used_As_Generic_Actual", Flag222 (Id));
W ("Uses_Sec_Stack", Flag95 (Id));
- W ("Vax_Float", Flag151 (Id));
W ("Warnings_Off", Flag96 (Id));
W ("Warnings_Off_Used", Flag236 (Id));
W ("Warnings_Off_Used_Unmodified", Flag237 (Id));
@@ -7735,6 +7719,9 @@ package body Einfo is
Concurrent_Kind =>
Write_Str ("Direct_Primitive_Operations");
+ when Float_Kind =>
+ Write_Str ("Float_Rep");
+
when E_In_Parameter |
E_Constant =>
Write_Str ("Discriminal_Link");
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index f496a13..c7a16bc 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1264,6 +1264,11 @@ package Einfo is
-- Note in particular that size clauses are present only for this
-- purpose, and should only be accessed if Has_Size_Clause is set.
+-- Float_Rep (Uint8)
+-- Present in floating-point entities. Contains a value of type
+-- Float_Rep_Kind. Together with the Digits_Value uniquely defines
+-- the floating-point representation to be used.
+
-- Freeze_Node (Node7)
-- Present in all entities. If there is an associated freeze node for
-- the entity, this field references this freeze node. If no freeze
@@ -3786,11 +3791,6 @@ package Einfo is
-- entries). Set to True when secondary stack is used in this scope and
-- must be released on exit unless Sec_Stack_Needed_For_Return is set.
--- Vax_Float (Flag151) [base type only]
--- Present in all type and subtype entities. Set only on the base type of
--- float types with Vax format. The particular format is determined by
--- the Digits_Value value which is 6,9,15 for F_Float, D_Float, G_Float.
-
-- Warnings_Off (Flag96)
-- Present in all entities. Set if a pragma Warnings (Off, entity-name)
-- is used to suppress warnings for a given entity. It is also used by
@@ -5094,6 +5094,7 @@ package Einfo is
-- E_Floating_Point_Type
-- E_Floating_Point_Subtype
-- Digits_Value (Uint17)
+ -- Float_Rep (Uint8) (Float_Rep_Kind)
-- Machine_Emax_Value (synth)
-- Machine_Emin_Value (synth)
-- Machine_Mantissa_Value (synth)
@@ -5108,6 +5109,7 @@ package Einfo is
-- Scalar_Range (Node20)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
+ -- Vax_Float (synth)
-- (plus type attributes)
-- E_Function
@@ -5669,6 +5671,15 @@ package Einfo is
Calign_Component_Size_4, -- natural for size <= 4, 4 for size >= 4
Calign_Storage_Unit); -- all components byte aligned
+ ----------------------------------
+ -- Floating Point Repesentation --
+ ----------------------------------
+
+ type Float_Rep_Kind is (
+ IEEE_Binary, -- IEEE 754p conform binary format
+ VAX_Native, -- VAX D, F, G or H format
+ AAMP); -- AAMP format
+
---------------
-- Iterators --
---------------
@@ -5848,6 +5859,7 @@ package Einfo is
subtype B is Boolean;
subtype C is Component_Alignment_Kind;
subtype E is Entity_Id;
+ subtype F is Float_Rep_Kind;
subtype M is Mechanism_Type;
subtype N is Node_Id;
subtype U is Uint;
@@ -5953,6 +5965,7 @@ package Einfo is
function First_Optional_Parameter (Id : E) return E;
function First_Private_Entity (Id : E) return E;
function First_Rep_Item (Id : E) return N;
+ function Float_Rep (Id : E) return F;
function Freeze_Node (Id : E) return N;
function From_With_Type (Id : E) return B;
function Full_View (Id : E) return E;
@@ -6532,6 +6545,7 @@ package Einfo is
procedure Set_First_Optional_Parameter (Id : E; V : E);
procedure Set_First_Private_Entity (Id : E; V : E);
procedure Set_First_Rep_Item (Id : E; V : N);
+ procedure Set_Float_Rep (Id : E; V : F);
procedure Set_Freeze_Node (Id : E; V : N);
procedure Set_From_With_Type (Id : E; V : B := True);
procedure Set_Full_View (Id : E; V : E);
@@ -6825,7 +6839,6 @@ package Einfo is
procedure Set_Unset_Reference (Id : E; V : N);
procedure Set_Used_As_Generic_Actual (Id : E; V : B := True);
procedure Set_Uses_Sec_Stack (Id : E; V : B := True);
- procedure Set_Vax_Float (Id : E; V : B := True);
procedure Set_Warnings_Off (Id : E; V : B := True);
procedure Set_Warnings_Off_Used (Id : E; V : B := True);
procedure Set_Warnings_Off_Used_Unmodified (Id : E; V : B := True);
@@ -7558,7 +7571,6 @@ package Einfo is
pragma Inline (Unset_Reference);
pragma Inline (Used_As_Generic_Actual);
pragma Inline (Uses_Sec_Stack);
- pragma Inline (Vax_Float);
pragma Inline (Warnings_Off);
pragma Inline (Warnings_Off_Used);
pragma Inline (Warnings_Off_Used_Unmodified);
@@ -7952,7 +7964,6 @@ package Einfo is
pragma Inline (Set_Unset_Reference);
pragma Inline (Set_Used_As_Generic_Actual);
pragma Inline (Set_Uses_Sec_Stack);
- pragma Inline (Set_Vax_Float);
pragma Inline (Set_Warnings_Off);
pragma Inline (Set_Warnings_Off_Used);
pragma Inline (Set_Warnings_Off_Used_Unmodified);
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 2e1073b..4da03df 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -4771,53 +4771,54 @@ package body Exp_Attr is
Ftp : Entity_Id;
begin
- -- For vax fpt types, call appropriate routine in special vax
- -- floating point unit. We do not have to worry about loads in
- -- this case, since these types have no signalling NaN's.
- if Vax_Float (Btyp) then
- Expand_Vax_Valid (N);
+ case Float_Rep (Btyp) is
+ -- For vax fpt types, call appropriate routine in special
+ -- vax floating point unit. We do not have to worry about
+ -- loads in this case, since these types have no signalling
+ -- NaN's.
- -- The AAMP back end handles Valid for floating-point types
+ when VAX_Native => Expand_Vax_Valid (N);
- elsif Is_AAMP_Float (Btyp) then
- Analyze_And_Resolve (Pref, Ptyp);
- Set_Etype (N, Standard_Boolean);
- Set_Analyzed (N);
+ -- The AAMP back end handles Valid for floating-point types
- -- Non VAX float case
+ when AAMP =>
+ Analyze_And_Resolve (Pref, Ptyp);
+ Set_Etype (N, Standard_Boolean);
+ Set_Analyzed (N);
- else
- Find_Fat_Info (Ptyp, Ftp, Pkg);
-
- -- If the floating-point object might be unaligned, we need
- -- to call the special routine Unaligned_Valid, which makes
- -- the needed copy, being careful not to load the value into
- -- any floating-point register. The argument in this case is
- -- obj'Address (see Unaligned_Valid routine in Fat_Gen).
-
- if Is_Possibly_Unaligned_Object (Pref) then
- Expand_Fpt_Attribute
- (N, Pkg, Name_Unaligned_Valid,
- New_List (
- Make_Attribute_Reference (Loc,
- Prefix => Relocate_Node (Pref),
- Attribute_Name => Name_Address)));
+ when IEEE_Binary =>
+ Find_Fat_Info (Ptyp, Ftp, Pkg);
- -- In the normal case where we are sure the object is
- -- aligned, we generate a call to Valid, and the argument in
- -- this case is obj'Unrestricted_Access (after converting
- -- obj to the right floating-point type).
+ -- If the floating-point object might be unaligned, we
+ -- need to call the special routine Unaligned_Valid,
+ -- which makes the needed copy, being careful not to
+ -- load the value into any floating-point register.
+ -- The argument in this case is obj'Address (see
+ -- Unaligned_Valid routine in Fat_Gen).
- else
- Expand_Fpt_Attribute
- (N, Pkg, Name_Valid,
- New_List (
- Make_Attribute_Reference (Loc,
- Prefix => Unchecked_Convert_To (Ftp, Pref),
- Attribute_Name => Name_Unrestricted_Access)));
- end if;
- end if;
+ if Is_Possibly_Unaligned_Object (Pref) then
+ Expand_Fpt_Attribute
+ (N, Pkg, Name_Unaligned_Valid,
+ New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => Relocate_Node (Pref),
+ Attribute_Name => Name_Address)));
+
+ -- In the normal case where we are sure the object is
+ -- aligned, we generate a call to Valid, and the argument
+ -- in this case is obj'Unrestricted_Access (after
+ -- converting obj to the right floating-point type).
+
+ else
+ Expand_Fpt_Attribute
+ (N, Pkg, Name_Valid,
+ New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => Unchecked_Convert_To (Ftp, Pref),
+ Attribute_Name => Name_Unrestricted_Access)));
+ end if;
+ end case;
-- One more task, we still need a range check. Required
-- only if we have a constraint, since the Valid routine
@@ -5468,7 +5469,7 @@ package body Exp_Attr is
raise Program_Error;
end case;
- -- If neither the base type nor the root type is VAX_Float then VAX
+ -- If neither the base type nor the root type is VAX_Native then VAX
-- float is out of the picture, and we can just use the root type.
else
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index dfbd788..8b1398c 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5646,7 +5646,7 @@ package body Sem_Ch3 is
-- already have been set if there was a constraint present.
Set_Digits_Value (Implicit_Base, Digits_Value (Parent_Base));
- Set_Vax_Float (Implicit_Base, Vax_Float (Parent_Base));
+ Set_Float_Rep (Implicit_Base, Float_Rep (Parent_Base));
if No_Constraint then
Set_Digits_Value (Derived_Type, Digits_Value (Parent_Type));
@@ -14730,7 +14730,7 @@ package body Sem_Ch3 is
Set_RM_Size (Implicit_Base, RM_Size (Base_Typ));
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
Set_Digits_Value (Implicit_Base, Digits_Value (Base_Typ));
- Set_Vax_Float (Implicit_Base, Vax_Float (Base_Typ));
+ Set_Float_Rep (Implicit_Base, Float_Rep (Base_Typ));
Set_Ekind (T, E_Floating_Point_Subtype);
Set_Etype (T, Implicit_Base);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index fb25906..4e3d3d4 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5703,18 +5703,6 @@ package body Sem_Util is
end loop;
end Inspect_Deferred_Constant_Completion;
- -------------------
- -- Is_AAMP_Float --
- -------------------
-
- function Is_AAMP_Float (E : Entity_Id) return Boolean is
- pragma Assert (Is_Type (E));
- begin
- return AAMP_On_Target
- and then Is_Floating_Point_Type (E)
- and then E = Base_Type (E);
- end Is_AAMP_Float;
-
-----------------------------
-- Is_Actual_Out_Parameter --
-----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 975d724..72adedb 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -653,14 +653,6 @@ package Sem_Util is
-- whether they have been completed by a full constant declaration or an
-- Import pragma. Emit the error message if that is not the case.
- function Is_AAMP_Float (E : Entity_Id) return Boolean;
- -- Defined for all type entities. Returns True only for the base type of
- -- float types with AAMP format. The particular format is determined by the
- -- Digits_Value value which is 6 for the 32-bit floating point type, or 9
- -- for the 48-bit type. This is not an attribute function (like VAX_Float)
- -- in order to not use up an extra flag and to prevent the dependency of
- -- Einfo on Targparm which would be required for a synthesized attribute.
-
function Is_Actual_Out_Parameter (N : Node_Id) return Boolean;
-- Determines if N is an actual parameter of out mode in a subprogram call
diff --git a/gcc/ada/sem_vfpt.adb b/gcc/ada/sem_vfpt.adb
index 2ffd122..0b46629 100644
--- a/gcc/ada/sem_vfpt.adb
+++ b/gcc/ada/sem_vfpt.adb
@@ -37,12 +37,11 @@ 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));
Init_Digits_Value (Base_Type (E), VAXDF_Digits);
- Set_Vax_Float (Base_Type (E), True);
+ Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
@@ -57,12 +56,11 @@ 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));
Init_Digits_Value (Base_Type (E), VAXFF_Digits);
- Set_Vax_Float (Base_Type (E), True);
+ Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
@@ -77,12 +75,11 @@ 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));
Init_Digits_Value (Base_Type (E), VAXGF_Digits);
- Set_Vax_Float (Base_Type (E), True);
+ Set_Float_Rep (Base_Type (E), VAX_Native);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
@@ -97,12 +94,11 @@ 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));
Init_Digits_Value (Base_Type (E), IEEEL_Digits);
- Set_Vax_Float (Base_Type (E), False);
+ Set_Float_Rep (Base_Type (E), IEEE_Binary);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
@@ -117,12 +113,11 @@ 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));
Init_Digits_Value (Base_Type (E), IEEES_Digits);
- Set_Vax_Float (Base_Type (E), False);
+ Set_Float_Rep (Base_Type (E), IEEE_Binary);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);