diff options
author | Geert Bosch <bosch@adacore.com> | 2010-10-22 10:15:36 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-10-22 12:15:36 +0200 |
commit | 23c799b1580c919c709a8144c27b53e013cd65e7 (patch) | |
tree | 552343c1a233a7faa791e3cc6cd60dc65e2dfa77 /gcc | |
parent | b4ca2d2c08cde1619a2394a02773712ded61dbce (diff) | |
download | gcc-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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 20 | ||||
-rw-r--r-- | gcc/ada/cstand.adb | 15 | ||||
-rw-r--r-- | gcc/ada/einfo.adb | 41 | ||||
-rw-r--r-- | gcc/ada/einfo.ads | 27 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 83 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 12 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 8 | ||||
-rw-r--r-- | gcc/ada/sem_vfpt.adb | 15 |
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); |