From 8575023cdc36ca4647811302e329a64e2df81634 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 10:11:06 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Thomas Quinot * s-fatgen.ads, s-fatgen.adb (S, P): New visible type declarations (Unaligned_Valid): Remove now unused subprogram. * exp_attr.adb (Expand_N_Attribute_Reference, case Attribute_Valid): If the prefix is in reverse SSO or potentially unaligned, copy it using a byte copy operation to a temporary variable. * einfo.adb: Minor comment fix. 2014-08-04 Hristian Kirtchev * freeze.adb (Freeze_Entity): Do not freeze formal subprograms. From-SVN: r213540 --- gcc/ada/ChangeLog | 14 ++++++ gcc/ada/einfo.adb | 2 +- gcc/ada/exp_attr.adb | 110 +++++++++++++++++++++++++++++++++---------- gcc/ada/freeze.adb | 8 +++- gcc/ada/s-fatgen.adb | 26 ---------- gcc/ada/s-fatgen.ads | 28 +++++------ 6 files changed, 117 insertions(+), 71 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 985c915be826..b7c71fd4796b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2014-08-04 Thomas Quinot + + * s-fatgen.ads, s-fatgen.adb (S, P): New visible type declarations + (Unaligned_Valid): Remove now unused subprogram. + * exp_attr.adb (Expand_N_Attribute_Reference, case + Attribute_Valid): If the prefix is in reverse SSO or potentially + unaligned, copy it using a byte copy operation to a temporary + variable. + * einfo.adb: Minor comment fix. + +2014-08-04 Hristian Kirtchev + + * freeze.adb (Freeze_Entity): Do not freeze formal subprograms. + 2014-08-04 Robert Dewar * s-imgrea.adb (Image_Floating_Point): Don't add space before +Inf. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 6afc37ceb3a3..631ddc76c588 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -563,7 +563,7 @@ package body Einfo is -- (Has_Protected) Flag271 -- (SSO_Set_Low_By_Default) Flag272 - -- (SSO_Set_Low_By_Default) Flag273 + -- (SSO_Set_High_By_Default) Flag273 -- Is_Generic_Actual_Subprogram Flag274 -- No_Predicate_On_Actual Flag275 diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 18ad6d1f3d74..f67220b61e2d 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; @@ -6406,6 +6407,23 @@ package body Exp_Attr is Pkg : RE_Id; Ftp : Entity_Id; + function Get_Fat_Entity (Nam : Name_Id) return Entity_Id; + -- Return entity for Pkg.Nam + + -------------------- + -- Get_Fat_Entity -- + -------------------- + + function Get_Fat_Entity (Nam : Name_Id) return Entity_Id is + Exp_Name : constant Node_Id := + Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (RTE (Pkg), Loc), + Selector_Name => Make_Identifier (Loc, Nam)); + begin + Find_Selected_Component (Exp_Name); + return Entity (Exp_Name); + end Get_Fat_Entity; + begin case Float_Rep (Btyp) is @@ -6419,34 +6437,76 @@ package body Exp_Attr is when IEEE_Binary => 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 the prefix is a reverse SSO component, or is + -- possibly unaligned, first create a temporary copy + -- that is in native SSO, and properly aligned. Make it + -- Volatile to prevent folding in the back-end. Note + -- that we use an intermediate constrained string type + -- to initialize the temporary, as the value at hand + -- might be invalid, and in that case it cannot be copied + -- using a floating point register. - 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))); + if In_Reverse_Storage_Order_Object (Pref) + or else + Is_Possibly_Unaligned_Object (Pref) + then + declare + Temp : constant Entity_Id := + Make_Temporary (Loc, 'F'); - -- 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). + Fat_S : constant Entity_Id := + Get_Fat_Entity (Name_S); + -- Constrained string subtype of appropriate size - 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))); + Fat_P : constant Entity_Id := + Get_Fat_Entity (Name_P); + -- Access to Fat_S + + Decl : constant Node_Id := + Make_Object_Declaration (Loc, + Defining_Identifier => Temp, + Aliased_Present => True, + Object_Definition => + New_Occurrence_Of (Ptyp, Loc)); + + begin + Set_Aspect_Specifications (Decl, New_List ( + Make_Aspect_Specification (Loc, + Identifier => + Make_Identifier (Loc, Name_Volatile)))); + + Insert_Actions (N, + New_List ( + Decl, + + Make_Assignment_Statement (Loc, + Name => + Make_Explicit_Dereference (Loc, + Prefix => + Unchecked_Convert_To (Fat_P, + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Temp, Loc), + Attribute_Name => + Name_Unrestricted_Access))), + Expression => + Unchecked_Convert_To (Fat_S, + Relocate_Node (Pref)))), + Suppress => All_Checks); + + Rewrite (Pref, New_Occurrence_Of (Temp, Loc)); + end; end if; + + -- We now have an object of the proper endianness and + -- alignment, and can call the Valid runtime routine. + + 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 case; -- One more task, we still need a range check. Required @@ -6462,7 +6522,7 @@ package body Exp_Attr is Left_Opnd => Relocate_Node (N), Right_Opnd => Make_In (Loc, - Left_Opnd => Convert_To (Btyp, Pref), + Left_Opnd => Convert_To (Btyp, Pref), Right_Opnd => New_Occurrence_Of (Ptyp, Loc)))); end if; end; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index fb4241a40aa2..971bc39d2e0a 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3818,8 +3818,12 @@ package body Freeze is then return No_List; - -- Generic types need no freeze node and have no delayed semantic - -- checks. + -- Formal subprograms are never frozen + + elsif Is_Formal_Subprogram (E) then + return No_List; + + -- Generic types are never frozen as they lack delayed semantic checks elsif Is_Generic_Type (E) then return No_List; diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb index be564cf6a0e2..62534f67c38c 100644 --- a/gcc/ada/s-fatgen.adb +++ b/gcc/ada/s-fatgen.adb @@ -918,30 +918,4 @@ package body System.Fat_Gen is ((E = IEEE_Emin - 1) and then abs To_Float (SR) = 1.0); end Valid; - --------------------- - -- Unaligned_Valid -- - --------------------- - - function Unaligned_Valid (A : System.Address) return Boolean is - subtype FS is String (1 .. T'Size / Character'Size); - type FSP is access FS; - - function To_FSP is new Ada.Unchecked_Conversion (Address, FSP); - - Local_T : aliased T; - - begin - -- Note that we have to be sure that we do not load the value into a - -- floating-point register, since a signalling NaN may cause a trap. - -- The following assignment is what does the actual alignment, since - -- we know that the target Local_T is aligned. - - To_FSP (Local_T'Address).all := To_FSP (A).all; - - -- Now that we have an aligned value, we can use the normal aligned - -- version of Valid to obtain the required result. - - return Valid (Local_T'Access); - end Unaligned_Valid; - end System.Fat_Gen; diff --git a/gcc/ada/s-fatgen.ads b/gcc/ada/s-fatgen.ads index 6c4e6f7b508d..d8d761eaaedb 100644 --- a/gcc/ada/s-fatgen.ads +++ b/gcc/ada/s-fatgen.ads @@ -94,24 +94,18 @@ package System.Fat_Gen is -- be an abnormal value that cannot be passed in a floating-point -- register, and the whole point of 'Valid is to prevent exceptions. -- Note that the object of type T must have the natural alignment - -- for type T. See Unaligned_Valid for further discussion. + -- for type T. - function Unaligned_Valid (A : System.Address) return Boolean; - -- This version of Valid is used if the floating-point value to - -- be checked is not known to be aligned (for example it appears - -- in a packed record). In this case, we cannot call Valid since - -- Valid assumes proper full alignment. Instead Unaligned_Valid - -- performs the same processing for a possibly unaligned float, - -- by first doing a copy and then calling Valid. One might think - -- that the front end could simply do a copy to an aligned temp, - -- but remember that we may have an abnormal value that cannot - -- be copied into a floating-point register, so things are a bit - -- trickier than one might expect. - -- - -- Note: Unaligned_Valid is never called for a target which does - -- not require strict alignment (e.g. the ia32/x86), since on a - -- target not requiring strict alignment, it is fine to pass a - -- non-aligned value to the standard Valid routine. + type S is new String (1 .. T'Size / Character'Size); + type P is access all S with Storage_Size => 0; + -- Buffer and access types used to initialize temporaries for validity + -- checks, if the value to be checked has reverse scalar storage order, or + -- is not known to be properly aligned (for example it appears in a packed + -- record). In this case, we cannot call Valid since Valid assumes proper + -- full alignment. Instead, we copy the value to a temporary location using + -- type S (we cannot simply do a copy of a T value, because the value might + -- be invalid, in which case it might not be possible to copy it through a + -- floating point register). private pragma Inline (Machine);